VBA Formeln per Makro in Zellen schreiben

Hallo hallo - habe es einfach hinter das letzte End With gesetzt und alles ist schöööööööön!!!

Danke Danke bis bald mal wieder

Frank

Hallo Claus

ich mach bestimmt was falsch oder habe was nicht definiert!!

Sub Makro1()

'

' Makro1 Makro

With Worksheets("Tabelle1")

ActiveCell.Offset(, 10).Formula = "=IF(AND(A1="""";B1="""");C1+D1;IF(A1<>"""";A1;IF(B1<>"""";B1)))"

End With

End Sub



Auf alle Fälle kommt Laufzeitfehler!! Habe die Werte in einer Testtabelle angepasst.

Gruß

Hallo,

du kannst die Formel direkt in den kompletten Bereich eingeben. Sie verhält sich dann so als ob sie heruntergezogen würde.

Probiere es mal so:

Sub Makro1()
Dim LRow As Long

With Worksheets("Tabelle1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("H1:H" & LRow).Formula = _
"=IF(AND(A1="""",B1=""""),C1+D1,IF(A1<>"""",A1,IF(B1<>"""",B1)))"
End With
End Sub

Claus

Nee, das geht so nicht. A) muss jedes " verdoppelt werden, weil " ist in VBA ein reserviertes Zeichen und B) musst Du FormulaLocal statt der FormulaR1C1Local nehmen.

Und mit ActiveCell.Offset(0, 10) würde ich niemals arbeiten, weil dann landet die Formel je nach aktueller Zelle irgendwo.

Schau Dir das Beispiel unten mal an und versuche es nach dem Schema nachzubauen.

Andreas.

Sub Example_HowToCreateAFormulaWithVBA()

 'Copy the formula from Excel as is

 ' =INDEX(C1:C2,MATCH($A$1,B1:B2,0))&"Whatever"

 'double each " sign inside:

 ' =INDEX(C1:C2,MATCH($A$1,B1:B2,0))&""Whatever""

 'surround the whole formula with " signs

 ' "=INDEX(C1:C2,MATCH($A$1,B1:B2,0))&""Whatever"""

 'Replace the cell references with a "placeholder" (any unique string that you like and doesn't exists elsewhere)

 ' "=INDEX(#C#,MATCH(#A#,#B#,0))&""Whatever"""

 'and assign to a string:

 Dim MyDefFormula As String

 MyDefFormula = "=INDEX(#C#,MATCH(#A#,#B#,0))&""Whatever"""

 

 'Now create the Range objects and refer to the real cells

 Dim a As Range, b As Range, c As Range

 Set a = Range("A1") 'A single cell

 Set b = Range("B2:B50") 'Multiple cells

 Set c = Range("C2", Range("C" & Rows.Count).End(xlUp)) 'From C2 to last used cell in column C

 'Note:

 ' You can refer to cells in an other sheet (note the dot in front of Range!):

 'With Worksheets("That")

 ' Set C = .Range("C2", .Range("C" & Rows.Count).End(xlUp))

 'End With

 ' Or other already opened files:

 'With Workbooks("This.xlsx").Worksheets("That")

 ' Set C = .Range("C2", .Range("C" & Rows.Count).End(xlUp))

 'End With

 

 'Make a copy of your default formula into a work string

 Dim MyFormula As String

 MyFormula = MyDefFormula

 'Replace the placeholders with the cell references

 MyFormula = Replace(MyFormula, "#A#", a.Address)

 'Note:

 ' The first arguments of Range.Address controls where the $ appears in the formula

 MyFormula = Replace(MyFormula, "#B#", b.Address(0, 0))

 'Note:

 ' The part 'External:=True' is necessary if you refer to other sheets or files

 ' But it works also if the reference is in the active sheet

 MyFormula = Replace(MyFormula, "#C#", c.Address(External:=True))

 

 'Write the formula into the cell

 Range("A2").Formula = MyFormula

 

 'Note:

 ' If your locale language is not English you can use the FormulaLocal property instead

 ' But in this case the code works only on PCs with your locale settings

 'Range("A2").FormulaLocal = MyFormula

 

 'Note:

 ' If you want to create array formulas use the FormulaArray property

 ' But in this case use must use English formulas, a FormulaArrayLocale doesn't exists

 'Range("A2:A10").FormulaArray = MyFormula

End Sub

Vielen Dank - aber das passt nicht oder steht an der falschen Stelle - auf jeden Fall es wird keine Formel ab H21 geschrieben.

Ich versuche da grad aus älteren Sub's von Dir was neues zusammen zu friemeln. Eigentlich soll die Formel in die Spalte Sonstige Provision wenn die Werte aus Arbeitsblatt IP_Auslieferungsliste geholt werden.

Ich hoffe Du hast noch eine Idee!!

Frank

Sub VerschiebenPerson()

Dim n%

Dim Zeilenzahl As Long, LRow As Long

Dim dest As Long



Application.ScreenUpdating = False

With Sheets("IP_Auslieferungsliste")

'Zeilenzahl Blatt1

LRow = .Cells(.Rows.Count, "B").End(xlUp).Row

For n = LRow To 2 Step -1





If .Cells(n, 5).Value = "Ali Berjaoui" Then 'Datensätze für Namen verschieben



dest = Sheets("Ali_Berjaoui").Cells(Rows.Count, 2).End(xlUp)(2).Row



i = i + 1

Sheets("Ali_Berjaoui").Range("A" & dest) = (i) 'Zähler SpalteA



Sheets("Ali_Berjaoui").Range("B" & dest) = .Range("N" & n).Value 'Kundennummer

Sheets("Ali_Berjaoui").Range("C" & dest) = .Range("B" & n).Value 'Datum

Sheets("Ali_Berjaoui").Range("F" & dest) = .Range("B" & n).Value 'Datum=Monat

Sheets("Ali_Berjaoui").Range("D" & dest) = .Range("I" & n).Value 'Fahrgestellnummer

Sheets("Ali_Berjaoui").Range("E" & dest) = .Range("AM" & n).Value 'Bruttobetrag

'Sheets("Ali_Berjaoui").Range("F" & dest) = .Range("?" & n).Value 'Auszahlungsmonat

'Sheets("Ali_Berjaoui").Range("G" & dest) = .Range("?" & n).Value 'Provision Fahrzeug

'Sheets("Ali_Berjaoui").Range("H" & dest) = .Range("?" & n).Value 'Sonstige Provision

'Sheets("Ali_Berjaoui").Range("I" & dest) = .Range("?" & n).Value 'Verkaufsberater

'Sheets("Ali_Berjaoui").Range("J" & dest) = .Range("?" & n).Value 'Abgleich Verkäufer

'Sheets("Ali_Berjaoui").Range("K" & dest) = .Range("?" & n).Value 'Art

Sheets("Ali_Berjaoui").Range("L" & dest) = .Range("R" & n).Value 'Standtage

'Sheets("Ali_Berjaoui").Range("M" & dest) = .Range("?" & n).Value 'GW Kummuliert

'Sheets("Ali_Berjaoui").Range("N" & dest) = .Range("?" & n).Value 'NW Kummuliert

Sheets("Ali_Berjaoui").Range("O" & dest) = .Range("O" & n).Value 'Kundenname



'-----------------------------------------------------------------------------------------------------------------------------



'With Worksheets("Tabelle1")

LRow = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range("H21:H" & LRow).Formula = "=IF(AND(A1="""",B1=""""),C1+D1,IF(A1<>"""",A1,IF(B1<>"""",B1)))"

'End With

'End Sub

'-----------------------------------------------------------------------------------------------------------------------------------





'Sheets("Ali_Berjaoui").Range("G" & dest) = .Formula = "=IF(AND("R"&n="""","U"&n=""""),"Q"&n+"T"&n,IF("R"&n<>"""","R"&n,IF("U"&n<>"""","U"&n)))"



'Sheets("Verkauft").Range("U" & dest) = Date

' Sheets("Verkauft").Range("A" & dest & ":R" & dest).Interior.Color = RGB(0, 176, 240)

'Sheets("Verkauft").Range("S" & dest).Interior.Color = RGB(230, 184, 183)

'Sheets("Verkauft").Range("T" & dest).Interior.Color = RGB(255, 255, 255)

'Sheets("Verkauft").Range("U" & dest).Interior.Color = RGB(191, 191, 191)

'.Rows(n).Delete

End If



'End If

Next



End With

Application.ScreenUpdating = True

End Sub