Zum Inhalt springen

Excel VBA: Formeln kopieren.. mit dynamischem Verweis??


Empfohlene Beiträge

Geschrieben

Hei :)

Ich hab ne Frage zu Excel und Makros... muss aber vorher gestehen, dass ich eigentlich null und nix mit Excel zutun hab, weil is eigentlich nicht mein gebiet.. aber für ein Projekt brauch ich halt n makro... ok genug vorgelabert

Also is es möglich, wenn zum beispiel in der Tabelle folgendes steht:


------------------------------------------------

|  A  |  B  |                     C                    |

------------------------------------------------

| 1  |   2 | =SUM(a1,b1)                       |

------------------------------------------------

| 8  |   3 |                                             |

------------------------------------------------

kann mensch dann die formel aus C so in die unteren Zeilen kopieren damit jede auf die richtige zeile verweist? Also in Zeile 2 steht dann =SUM(a2,b2), in der dritten =SUM(a3,b3) und so weiter und sofort... jedenfalls soll das kopieren halt von nem makro erledigt werden... funzt das?

Wäre echt chillig

Big thx

Geschrieben

mit diesem Makro sollte es in etwa funktionieren. wenn Du noch fragen dazu hast gib bescheid.

Sub Makro2()

Dim strFormular As String

Dim lngCount As Long

Dim lngIndex As Long

strFormular = Range("C1").Formula

lngCount = InputBox("Wieviele Zeilen sollen mit Formel aus C1 gefüllt werden?")

For lngIndex = 2 To lngCount

Range("C" & lngIndex).Formula = Replace(strFormular, "1", lngIndex)

Next lngIndex

End Sub

Gruß

Guido

Geschrieben

Hei :)

Danke erstma :)

Also ich progge das Excel nicht, ich darf hier ne anwendung proggern die n csv bereitstellt für ein das makro...

jedenfalls müsste ich im csv die formeln erstellen was leicht kompiliziert werden würde.. weil sich das ganze über mehere tabellen verteilt und so und da is eine gescheite einhaltung der richtigen zeilennummern halt fehlergefährdeter als wenn excel das mal schön selbst macht.. jedenfalls hab ich den source mal dem vba progger hier gegeben und der meinte "geht nicht.. da krieg ich ne fehlermeldung Objekt oder Anwendungsfehler oder so"... reproduzieren wollte er es leider net.

Jedenfalls dass hier ist sein makro.. das halt formeln nicht korrekt kopiert:



Function Spalte(nr)


  If nr = 1 Then Spalte = "A"

  If nr = 2 Then Spalte = "B"

  If nr = 3 Then Spalte = "C"

  If nr = 4 Then Spalte = "D"

  If nr = 5 Then Spalte = "E"

  If nr = 6 Then Spalte = "F"

  If nr = 7 Then Spalte = "G"

  If nr = 8 Then Spalte = "H"

  If nr = 9 Then Spalte = "I"

  If nr = 10 Then Spalte = "J"

  If nr = 11 Then Spalte = "K"

  If nr = 12 Then Spalte = "L"

  If nr = 13 Then Spalte = "M"

  If nr = 14 Then Spalte = "N"

  If nr = 15 Then Spalte = "O"

  If nr = 16 Then Spalte = "P"

  If nr = 17 Then Spalte = "Q"

  If nr = 18 Then Spalte = "R"

  If nr = 19 Then Spalte = "S"

  If nr = 20 Then Spalte = "T"

  If nr = 21 Then Spalte = "U"

  If nr = 22 Then Spalte = "V"

  If nr = 23 Then Spalte = "W"

  If nr = 24 Then Spalte = "X"

  If nr = 25 Then Spalte = "Y"

  If nr = 26 Then Spalte = "Z"

  If nr = 27 Then Spalte = "AA"

  If nr = 28 Then Spalte = "AB"

  If nr = 29 Then Spalte = "AC"

  If nr = 30 Then Spalte = "AD"

  If nr = 31 Then Spalte = "AE"

  If nr = 32 Then Spalte = "AF"

  If nr = 33 Then Spalte = "AG"

  If nr = 34 Then Spalte = "AH"

  If nr = 35 Then Spalte = "AI"

  If nr = 36 Then Spalte = "AJ"

  If nr = 37 Then Spalte = "AK"

  If nr = 38 Then Spalte = "AL"

  If nr = 39 Then Spalte = "AM"

  If nr = 40 Then Spalte = "AN"

  If nr = 41 Then Spalte = "AO"

  If nr = 42 Then Spalte = "AP"

  If nr = 43 Then Spalte = "AQ"

  If nr = 44 Then Spalte = "AR"

  If nr = 45 Then Spalte = "AS"

  If nr = 46 Then Spalte = "AT"

  If nr = 47 Then Spalte = "AU"

  If nr = 48 Then Spalte = "AV"

  If nr = 49 Then Spalte = "AW"

  If nr = 50 Then Spalte = "AX"

  If nr = 51 Then Spalte = "AY"

  If nr = 52 Then Spalte = "AZ"


  If nr = 53 Then Spalte = "BA"

  If nr = 54 Then Spalte = "BC"

  If nr = 55 Then Spalte = "BD"

  If nr = 56 Then Spalte = "BE"

  If nr = 57 Then Spalte = "BF"

  If nr = 58 Then Spalte = "BG"

  If nr = 59 Then Spalte = "BH"

  If nr = 60 Then Spalte = "BI"

  If nr = 61 Then Spalte = "BJ"

  If nr = 62 Then Spalte = "BK"



  If nr = 63 Then Spalte = "BL"

  If nr = 64 Then Spalte = "BM"

  If nr = 65 Then Spalte = "BN"

  If nr = 66 Then Spalte = "BO"

  If nr = 67 Then Spalte = "BP"

  If nr = 68 Then Spalte = "BQ"

  If nr = 69 Then Spalte = "BR"

  If nr = 70 Then Spalte = "BS"

  If nr = 71 Then Spalte = "BT"

  If nr = 72 Then Spalte = "BU"

  If nr = 73 Then Spalte = "BV"

  If nr = 74 Then Spalte = "BW"

  If nr = 75 Then Spalte = "BX"

  If nr = 76 Then Spalte = "BY"

  If nr = 77 Then Spalte = "BZ"


  If nr > 77 Then Spalte = "CA"




End Function


Sub Basisdaten_Einlesen()

'

' Basisdaten_Einlesen Makro

' Makro am 10.06.2003 von Michael Schmuck aufgezeichnet

'


'


Set conn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.Recordset")

conn.Open "DSN=Pivot"


rs.Open "select fir, ndl, ber, akdnr, aname1, aname2, astr, alkz, aplz, aort, aabc, ekdnr, ename1, ename2, estr, elkz, eplz, eort, fkdnr, fname1, flkz, fplz, fort, rel, skdnr, sname1, sort, idsnr, abord, ebord, alali, aroll, roll, aart, sart, sendnr, datum, fra, fratxt, fp, gp, vprest, sbanz, tgew, fgew, rgew, cbmk, cbms, lmk, lms, status, tkey1, tkey2, wawe, nn, ggvs, km, ums, rrsa, rrse, rrsx, uaabh, uazus, db1, db1pz, rgnr, rgdat, df005, df006, df007, df008 from pool limit 1000", conn


cnt = 2

On Error Resume Next


Do While Not (rs.EOF)

  Worksheets("Basis_1").Range("A" & cnt).Select

  Worksheets("Basis_1").Range("A" & cnt).Value = rs("fir")

  Worksheets("Basis_1").Range("B" & cnt).Value = rs("ndl")

  Worksheets("Basis_1").Range("C" & cnt).Value = rs("ber")

  Worksheets("Basis_1").Range("D" & cnt).Value = rs("akdnr")

  Worksheets("Basis_1").Range("E" & cnt).Value = rs("aname1")

  Worksheets("Basis_1").Range("F" & cnt).Value = rs("aname2")

  Worksheets("Basis_1").Range("G" & cnt).Value = rs("astr")

  Worksheets("Basis_1").Range("H" & cnt).Value = rs("alkz")

  Worksheets("Basis_1").Range("I" & cnt).Value = rs("aplz")

  Worksheets("Basis_1").Range("J" & cnt).Value = rs("aort")

  Worksheets("Basis_1").Range("K" & cnt).Value = rs("aabc")

  Worksheets("Basis_1").Range("L" & cnt).Value = rs("ekdnr")

  Worksheets("Basis_1").Range("M" & cnt).Value = rs("ename1")

  Worksheets("Basis_1").Range("N" & cnt).Value = rs("ename2")

  Worksheets("Basis_1").Range("O" & cnt).Value = rs("estr")

  Worksheets("Basis_1").Range("P" & cnt).Value = rs("elkz")

  Worksheets("Basis_1").Range("Q" & cnt).Value = rs("eplz")

  Worksheets("Basis_1").Range("R" & cnt).Value = rs("eort")

  Worksheets("Basis_1").Range("S" & cnt).Value = rs("fkdnr")

  Worksheets("Basis_1").Range("T" & cnt).Value = rs("fname1")

  Worksheets("Basis_1").Range("U" & cnt).Value = rs("flkz")

  Worksheets("Basis_1").Range("V" & cnt).Value = rs("fplz")

  Worksheets("Basis_1").Range("W" & cnt).Value = rs("fort")

  Worksheets("Basis_1").Range("X" & cnt).Value = rs("rel")

  Worksheets("Basis_1").Range("Y" & cnt).Value = rs("skdnr")

  Worksheets("Basis_1").Range("Z" & cnt).Value = rs("sname1")


  Worksheets("Basis_1").Range("AA" & cnt).Value = rs("sort")

  Worksheets("Basis_1").Range("AB" & cnt).Value = rs("idsnr")

  Worksheets("Basis_1").Range("AC" & cnt).Value = rs("abord")

  Worksheets("Basis_1").Range("AD" & cnt).Value = rs("ebord")

  Worksheets("Basis_1").Range("AE" & cnt).Value = rs("alali")

  Worksheets("Basis_1").Range("AF" & cnt).Value = rs("aroll")

  Worksheets("Basis_1").Range("AG" & cnt).Value = rs("roll")

  Worksheets("Basis_1").Range("AH" & cnt).Value = rs("aart")

  Worksheets("Basis_1").Range("AI" & cnt).Value = rs("sart")

  Worksheets("Basis_1").Range("AJ" & cnt).Value = rs("sendnr")

  Worksheets("Basis_1").Range("AK" & cnt).Value = rs("datum")

  Worksheets("Basis_1").Range("AL" & cnt).Value = rs("fra")

  Worksheets("Basis_1").Range("AM" & cnt).Value = rs("fratxt")

  Worksheets("Basis_1").Range("AN" & cnt).Value = rs("fp")

  Worksheets("Basis_1").Range("AO" & cnt).Value = rs("gp")

  Worksheets("Basis_1").Range("AP" & cnt).Value = rs("vprest")

  Worksheets("Basis_1").Range("AQ" & cnt).Value = rs("sbanz")

  Worksheets("Basis_1").Range("AR" & cnt).Value = rs("tgew")

  Worksheets("Basis_1").Range("AS" & cnt).Value = rs("fgew")

  Worksheets("Basis_1").Range("AT" & cnt).Value = rs("rgew")

  Worksheets("Basis_1").Range("AU" & cnt).Value = rs("cbmk")

  Worksheets("Basis_1").Range("AV" & cnt).Value = rs("cbms")

  Worksheets("Basis_1").Range("AW" & cnt).Value = rs("lmk")

  Worksheets("Basis_1").Range("AX" & cnt).Value = rs("lms")

  Worksheets("Basis_1").Range("AY" & cnt).Value = rs("status")


  Worksheets("Basis_1").Range("AZ" & cnt).Value = rs("tkey1")

  Worksheets("Basis_1").Range("BA" & cnt).Value = rs("tkey2")

  Worksheets("Basis_1").Range("BB" & cnt).Value = rs("wawe")

  Worksheets("Basis_1").Range("BC" & cnt).Value = rs("nn")

  Worksheets("Basis_1").Range("BD" & cnt).Value = rs("ggvs")

  Worksheets("Basis_1").Range("BE" & cnt).Value = rs("km")

  Worksheets("Basis_1").Range("BF" & cnt).Value = rs("ums")

  Worksheets("Basis_1").Range("BG" & cnt).Value = rs("rrsa")

  Worksheets("Basis_1").Range("BH" & cnt).Value = rs("rrse")

  Worksheets("Basis_1").Range("BI" & cnt).Value = rs("rrsx")

  Worksheets("Basis_1").Range("BJ" & cnt).Value = rs("uaabh")

  Worksheets("Basis_1").Range("BK" & cnt).Value = rs("uazus")

  Worksheets("Basis_1").Range("BL" & cnt).Value = rs("db1")

  Worksheets("Basis_1").Range("BM" & cnt).Value = rs("db1pz")

  Worksheets("Basis_1").Range("BN" & cnt).Value = rs("rgnr")

  Worksheets("Basis_1").Range("BO" & cnt).Value = rs("rgdat")







  Worksheets("Basis_1").Range("BP" & cnt).Value = rs("df005")


  Worksheets("Basis_1").Range("BQ" & cnt).Value = rs("df006")

  Worksheets("Basis_1").Range("BR" & cnt).Value = rs("df007")

  Worksheets("Basis_1").Range("BS" & cnt).Value = rs("df008")


  cnt = cnt + 1

  rs.movenext

Loop



Exit Sub


ende teil 1 (10000 zeichen begrenzung)

Geschrieben

code teil 2



  Set fso = CreateObject("Scripting.FileSystemObject")

  Set datei = fso.OpenTextFile("basis_1.csv", 1, False, 0)

  cnt = 0

  cnt_sheet = 1

  cnt_zelle = 2

  Worksheets("ImportStatus").Range("C8").Value = "ARBEITE"

  Worksheets("ImportStatus").Range("C9").Value = Time

  zeile = datei.readline


  Do While datei.AtEndOfStream <> True

    zeile = datei.readline



    Rem MsgBox (GetPart(zeile, 1))



    Zelle = "A" & cnt_zelle

    Worksheets("Basis_" & cnt_sheet).Range(Zelle).Value = zeile


    For cnt_spalte = 1 To 71 Step 1


      i = InStr(zeile, ";")

      If i = 0 Then Exit For


      tmp = Left(zeile, i - 1)


      zeile = Right(zeile, Len(zeile) - i)



      Worksheets("Basis_" & cnt_sheet).Range(Spalte(cnt_spalte) & cnt_zelle).Value = tmp

     Next cnt_spalte


    Worksheets("Basis_" & cnt_sheet).Range("HI" & cnt_zelle).Select

    Rem Worksheets("Basis_" & cnt_sheet).Range("HJ" & cnt_zelle).Formula = "=WOCHENTAG(AK" & cnt_zelle & ")"



    If cnt_zelle = 65536 Then

      cnt_zelle = 2

      cnt_sheet = cnt_sheet + 1

    End If

    cnt_zelle = cnt_zelle + 1

    cnt = cnt + 1


    Worksheets("ImportStatus").Range("C5").Value = cnt

    Worksheets("ImportStatus").Range("C6").Value = "Basis_" & cnt_sheet

    Worksheets("ImportStatus").Range("C7").Value = cnt_zelle

  Loop

  Worksheets("ImportStatus").Range("C8").Value = "FERTIG"

  Worksheets("ImportStatus").Range("C10").Value = Time


End Sub


Sub FastImport()

'

' FastImport Makro

' Makro am 11.06.2003 von Michael Schmuck aufgezeichnet

'


  For t = 1 To 5 Step 1


    Worksheets("Basis_" & t).Select

    Worksheets("Basis_" & t).Range("A1").Select

    With ActiveSheet.QueryTables.Add(Connection:= _

        "TEXT;" & Application.ActiveWorkbook.Path & "\basis_" & t & ".csv", Destination _

        :=Range("A1"))

        .Name = "basis_" & t

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .TextFilePromptOnRefresh = False

        .TextFilePlatform = xlWindows

        .TextFileStartRow = 1

        .TextFileParseType = xlDelimited

        .TextFileTextQualifier = xlTextQualifierDoubleQuote

        .TextFileConsecutiveDelimiter = False

        .TextFileTabDelimiter = False

        .TextFileSemicolonDelimiter = False

        .TextFileCommaDelimiter = False

        .TextFileSpaceDelimiter = False

        .TextFileOtherDelimiter = "|"

        .Refresh BackgroundQuery:=False

    End With


  Next t



End Sub


aber ich kann dazu net viel sagen, weil ich voll in meinem zeitpaln hänge und mich deshalb net mit vba beschäfftigen kann :)

Geschrieben

was muss den nun genau ein gelesen werden?? nur die CSV Datei?? und das aus VB herraus oder wie soll ich das verstehen? oder sollen die Daten aus einer DB kommen und dann noch etwas berechnet werden?

Ist ein wenig viel Code der da produziert wird.

Guido

Geschrieben

also das project funzt so:

Wir haben hier nen DB-Server, auf dem liegen so 100GB Daten.

Mein Teil ist folgender:

Application/Servlet erstellen, das

-User-Rechte prüft (nicht jeder User darf alles sehen :)

-User aus vorgefertigten Abfragen auswählen lässt

-Erstellen der CSV dateien.. hat müssen halt ein ganz bestimmtes format haben, also am schluss die Formeln zur Berechung und so.

-Ablegen der Dateien in einen bestimmten Ordner

-Starten von Excel mit dem Makroaufruf..

so.. nun kommt das Makro vom Kollegen:

-Einlesen der CSV-Daten

-Aufbereitung der Daten für Pivot-tabelle

-Pivot starten

Das problem is, dass der VBA-progger halt sagt, dass ihc das mit den formeln machen soll... aber eigentlich isses für ihn halt wesentlich einfacher, denk ich ma.. zumindest..

Ist ein wenig viel Code der da produziert wird.

Dazu sach ich ma nix zu :D

Geschrieben

Also wenn ich das richtig verstehe kannst du die Summen oder so nicht direkt bei auslesen aus der DB machen. denn dann wären die Formeln überflüssig.

dann würd ich hingehen eine Excel Instanz erstellen und die CSV einlesen. aber nicht eine Zeile nach der anderen, sondern alles komplett, also nur öffnen unter Excel. Dann die Formeln in die bestimmten Zeilen schreiben lassen.

Sollte so schneller sien als wie jetzt.

Geschrieben

Das aus der Datenbank berechnen geht net, weil es beim excel noch ein blatt mit statischen daten gibt.. und da kommen teile für die formel her..also bezüge...

mir wärs halt recht, wenn beim import von dem csv .. da stehen die formeln ja drin.. die erste vorkommende so nach unten kopiert werden könnte damit die bezüge passen..

Geschrieben

Welche Excel Version verwendest du??

Also in Excel 2000 hab ich da folgendes Beispiel:

<code>

Sub Makro1()

Range("C1").Select

ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

Range("C1").Select

Selection.AutoFill Destination:=Range("C1:C5"), Type:=xlFillDefault

Range("C1:C5").Select

End Sub

->in Spalte C steht jetzt jeweils drin "=SUMME(A1:B1)" je nach Zeilenzahl halt

Geschrieben
Original geschrieben von LoCal

Hei :)

Ich hab ne Frage zu Excel und Makros... muss aber vorher gestehen, dass ich eigentlich null und nix mit Excel zutun hab, weil is eigentlich nicht mein gebiet.. aber für ein Projekt brauch ich halt n makro... ok genug vorgelabert

Also is es möglich, wenn zum beispiel in der Tabelle folgendes steht:



------------------------------------------------

|  A  |  B  |                     C                    |

------------------------------------------------

| 1  |   2 | =SUM(a1,b1)                       |

------------------------------------------------

| 8  |   3 |                                             |

------------------------------------------------

kann mensch dann die formel aus C so in die unteren Zeilen kopieren damit jede auf die richtige zeile verweist? Also in Zeile 2 steht dann =SUM(a2,b2), in der dritten =SUM(a3,b3) und so weiter und sofort... jedenfalls soll das kopieren halt von nem makro erledigt werden... funzt das?

Wäre echt chillig

Big thx

Äh aber ihr wollt nicht einfach den Doppelklick, den man auf das schwarze Kreuz in der Zelle C1 am rechten unteren Rand machen kann, nachprogrammieren?
Geschrieben

ärrmmm doch....

aber bitte nicht "IHR"... sondern son VBA-"Checker" hier... ich will mit dem ***-Zeugs nicht zutun haben ;D

Is ja witzig.. scheinbar ist die Kurzschreibweise von Micro$oft n Schimpfwort für das FI-Forum... weil MplusDollarzeichen wird immer ausgestern :)

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...