Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro bescheunigen

Makro bescheunigen
19.04.2017 10:59:31
Zoi
Hallo,zusammen,ich möchte gerne fragen wie ich mein Makro beschleunigen kann?
Ich habe ganz lange liste mit Daten die ich vergleichen und wenn es stimmt übertragen von eine Arbeitsmappe in andere. Das Makro leuft, aber sehr langsam, ich kann es noch hochladen falls nötig ist?
Grüße,Zoi

31
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro bescheunigen
19.04.2017 11:02:18
SF
Hola,
ich bin zwar kein VBA'ler, aber wenn du die Werkstatt bittest, dein Auto schneller zu machen, dann bringst du doch das Auto auch mit, oder nicht?
Gruß,
steve1da
AW: Makro beschleunigen
19.04.2017 11:05:48
Zoi

Sub Transfer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim Partnumber As String
Dim wb1, wb2 As Workbook
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
'How many rows are in the sheet weight integrated
lastrow1 = wb1.Sheets("PartList").Range("C" & Rows.Count).End(xlUp).Row
lastrow2 = wb2.Sheets("gewicht").Range("C" & Rows.Count).End(xlUp).Row
'compare the Partname with loop ,first reed the number
For i = 2 To lastrow2
Partnumber = wb2.Sheets("gewicht").Cells(i, "C").Value
'How many rows are in the partlist integrated
'loop from second row till the end as long as rows are there in the Partlist
For j = 4 To lastrow1
'compare
If wb1.Sheets("PartList").Cells(j, "C").Value = Partnumber Then
wb2.Sheets("gewicht").Activate
'Selecting the range of the cells which have to be copied
wb2.Sheets("gewicht").Range(Cells(i, "K"), Cells(i, "M")).Copy
wb1.Sheets("PartList").Activate
wb1.Sheets("PartList").Range(Cells(j, "CQ"), Cells(j, "CS")).Select
ActiveSheet.Paste
End If
Next j
Application.CutCopyMode = False
Next i
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Makro beschleunigen
19.04.2017 11:14:59
Rainer
Hallo Zoi,
bezogen auf den Kommentar von SF: Jetzt hast du uns das Handbuch gegeben, aber wo ist das Auto? Keiner kennt die Art deiner Daten, bitte lade deine Datei hoch!
Auf die schnelle würde ich meinen, dass du die ganzen "Activate" Befehle weglassen kannst.

Worksheets("Sheet1").Range("A1:D4").Copy _
destination:=Worksheets("Sheet2").Range("E5")
Aber ganz im Ernst, ich habe das Gefühl dass es auch ohne VBA über INDEX() und VERGLEICH() lösbar wäre.
Aber das bleibt solange Spekulation, wie es keine Beispieldatei gibt.
Gruß,
Rainer
Anzeige
AW: Makro beschleunigen
19.04.2017 12:33:05
Zoi
Hallo wieder, bezogen auf das kommentar von Rainer und SF,
die daten vom Gewicht , die übernommen werden sind zahlen die in drei spalten aufgeschrieben sind, und mussen erstmal vom text in zahl konvertiert sein,damit kein fehler auftritt, und dann nach dem Vergleich mit den Partnumber ( daten die sind buchstaben und ziffern zusammen) , in entsprechende drei spalten in Partlist eingetragen.
Hoffe es reicht, ich kann leider die daten nicht hoch laden
Grüß,Zoi
AW: Makro beschleunigen
19.04.2017 13:55:39
Max2
Hallo,
du führst eine Zählergesteuerte Schleife innerhalb einer Zählergesteuerten Schleife aus.
Du hast also ein quadratisches Wachstum: f(n) = n²

Wenn n sich verdoppelt, dann vervierfacht sich f(n).

Versuche also, keine verschachtelten Algorithmen zu schreiben.
Sie sind zwar einfach und man schreibt Sie schnell, aber mit ein
bisschen nachdenken und Kopfzerbrechen kommt man immer auf was besseres.
Um dir ernsthaft helfen zu können braucht aber ein jeder hier die Beispielmappe.
Anzeige
AW: Makro bescheunigen
19.04.2017 11:29:39
ChrisL
Hi
Ich vermute so...
Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("PartList")
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets("gewicht")
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If WorksheetFunction.CountIf(ws1.Columns(3), ws2.Cells(i, 3)) > 0 Then
findZeile = Application.Match(ws2.Cells(i, 3), ws1.Columns(3), 0)
ws2.Range(Cells(i, "K"), Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
End If
Next i
Application.Calculation = xlAutomatic
End Sub
cu
Chris
Anzeige
AW: Makro bescheunigen
19.04.2017 12:19:34
Zoi
ok,danke ich versuche es mit dem code von Chris und melde mich ! :)
Grüße
AW: Makro bescheunigen
19.04.2017 13:10:28
Zoi
Hallo Chris,
es hat gelaufen, nun in die Spalte CQ sind die daten übertragen, und in die entsprechende weitere zwei spalten nicht, es gibt meldung laufzeitfehler 13, typen unverträglich!
AW: Makro bescheunigen
19.04.2017 13:38:13
Matthias
Hallo! Ersetze einfach mal die Zeile hier
ws2.Range(Cells(i, "K"), Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
durch die
ws2.Range(ws2.Cells(i, "K"), ws2.Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
dann sollte es auch klappen. Da du 2 Datein offen hast, klappt sonst die Zuordnung nicht ganz.
Und evtl. vor dem end sub noch ein
Application.screenupdating = True
einfügen. Ist aber geschmackssache. Mit der Änderung von Chris sollt dein Code wesentlich schneller sein. Um wieiviele Zeilen handelt es sich den immer (wegen der Kosten Nutzen Rechnung ob man noch mehr versuchen sollte)?
VG
Anzeige
AW: Makro bescheunigen
19.04.2017 13:43:10
ChrisL
ups... Danke Matthias, habe ich übersehen.
Ob der allerdings der Typenfehler damit auch behoben ist werden wir sehen ;)
AW: Makro bescheunigen
19.04.2017 13:50:50
Zoi
Halo zusammen,
die typen fehler ist nicht behoben,
allerdings es funktioniert die Übertragung nur in die erste Spalte CQ .
Die Partnummer sind ungf.4000, kann auch mehr sein, und die zweite liste von denen die übertragen gomen werden sind 17000.
Grüße und Vielen Dank für euere Mühe!
AW: Makro bescheunigen
19.04.2017 14:45:02
Matthias
Gut dann ein neuer Versuch. Mal bitte die Zeilen hier tauschen. Aus

If WorksheetFunction.CountIf(ws1.Columns(3), ws2.Cells(i, 3)) > 0 Then
findZeile = Application.Match(ws2.Cells(i, 3), ws1.Columns(3), 0)
bitte das machen
If WorksheetFunction.CountIf(ws1.Columns(3), clng(ws2.Cells(i, 3))) > 0 Then
findZeile = Application.Match(clng(ws2.Cells(i, 3)), ws1.Columns(3), 0)
Das Problem ist vermtl., dass deine "Zahlen" als Text da stehen (hattest du am Anfang mal irgendwo geschrieben). Der CountIf ist das wurscht, da sie eh nach Variant Typen sucht und nichts vergleicht. Die match benötigt aber das selbe Format (in der Spalte und vom Suchwert). Daher kommt dort der Fehler. So wird dein Text als Zahl umgewandelt und sollte passen.
Wegen der Spalten müsste man vllt in der Originaldatei schauen. Soll wirklich aus den Spalten K L und M kopiert werden und stehen da auch Daten drin? Wird auch wirklich nur der Wert aus K übertagen und wenn ja in die richtige Spalte oder ist der irgendwie versetzt?
VG
Anzeige
AW: Makro bescheunigen
19.04.2017 15:09:03
Zoi
Hi Matthias,
ja du hast recht,kann daran liegen ,weil die Zahlen die als Text gespeichert sind,müssen erstmal in zahlen umgewandelt und dann übertragen,also mit der erste Variante funktioniert das die Werte richtig eingetragen sind in richtige Spalte , die Sache ist das in den nächsten zwei Spalten kommen keine werte rein, und die Fehler 13 Meldung.
ich habe versucht mit CLng.wie du geschrieben hast, aber die fehler ist noch da, und jetzt die Übertragung ist gar nicht gemacht.
Ich weiss nicht andere Alternative?
AW: Makro bescheunigen
19.04.2017 13:54:22
Matthias
Kein Problem! Habe nochmal geschaut. Ein Typfehler dürfte eigentlich nicht entstehen. Der Code kopiert ja nur die Zelleninhalte. Die einzige Zuweisung erfolgt ja an findZeile (von den set abgesehen). Und das wird ja eigentlich durch das match vorher abgefangen. Hatte die Dateien auch mal schnell getestet. Bei mir lief es durch. VG
Anzeige
Beispieldatei
19.04.2017 13:39:51
ChrisL
Hi
Spätestens jetzt ist es Zeit für die Beispieldatei.
cu
Chris
AW: Beispieldatei
19.04.2017 16:14:39
Zoi
beispiel datein sind hochgeladen! Ich hoffe es kann Sie was helfen"!
Danke!
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 16:17:53
Gerd
Gruß Gerd
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 16:27:06
Zoi
Was meinen Sie link fehlt? , und was bedeutet o.T.?
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 16:40:50
ChrisL
Nach dem Hochladen musst du den Link in den Beitrag kopieren. So sehen wir die Dateien nicht.
o.T. = ohne Text (nur Titel)... Nebensache
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 16:41:23
Zoi
Userbild
Userbild
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 16:43:06
ChrisL
und jetzt noch im Excelformat hochladen, dann hast du es geschafft...
Anzeige
AW: Link auf Beispieldatei fehlt! o.T.
19.04.2017 18:14:49
Matthias
So, bin auch wieder da. :-) Also mit solchen Beispielen kann man wenigstens schonmal ein wenig anfangen. So wie ich deine Beispiele sehe, suchst du aber nicht Zahlen sondern Strings. Habe mal schnell die Datei nachgestellt (an Hand der Bilder). Anstelle es Clng von vorhin würde ich jetzt ein cstr nehmen. Im Test hat es geklappt und auch alle 3 Spalten übertragen. Wäre dann so. VG

Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("PartList")
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets("gewicht")
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If WorksheetFunction.CountIf(ws1.Columns(3), CStr(ws2.Cells(i, 3))) > 0 Then
findZeile = Application.Match(CStr(ws2.Cells(i, 3)), ws1.Columns(3), 0)
ws2.Range(ws2.Cells(i, "K"), ws2.Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Anzeige
AW: Link auf Beispieldatei fehlt! o.T.
20.04.2017 08:39:59
Zoi
Hallo Matthias,
vielen Dank noch Mal,ich hab es probiert und es ist immer noch gleich ,Laufzeitfehler 13, und nur die erste Spalte ausgefühlt, ich glaube es liegt daran das die Zahlen in wb2, wo ich übernehme sind als text gespeichert, und die müssen erstmal in zahl konvertiert sein. oder ist was anderes,
Grüße,Zoi
AW: Link auf Beispieldatei fehlt! o.T.
20.04.2017 10:11:27
Matthias
Moin! Also wie gesagt, ohne mal die Datei zu sehen wird es schwierig. In meinem Testlauf hier hat alles geklappt. Da der Fehler bei match entsteht und ich den so grad nicht eingrenzen kann, habe ich halt die suchefunktion geändert. Im Test klappt es auch wieder. Ich kann jetzt auch grad nicht erklären, warum nur die erste Zelle kopiert wird. Das wäre jetzt so mit die letzte Variante die mir einfällt. Ansonsten könntest du bei deinem Ursprungscode (der ging ja wohl) noch ein Abbruchkriterium einfügen (beim Treffer und dem Kopieren noch ein exit for rein). Damit wird die zweite Schleife nach einem Treffer abgebrochen und die andere WErte (die ja nicht mehr notwendig sind verworfen). Alternativ könntest du vorher die Listen sortieren und dann die zweite Schleife immer an die Kriterien anpassen. DAmit begrenzt du die Suche und es werden nicht mehr so viele unnötige Vergleich durchgeführt. Hier erstmal die geänderte Variaten. VG

Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim treffer As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("PartList")
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets("gewicht")
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
Set treffer = ws1.Columns(3).Find(CStr(ws2.Cells(i, 3)), LookIn:=xlValues)
If Not treffer Is Nothing Then
findZeile = treffer.Row
ws2.Range(ws2.Cells(i, "K"), ws2.Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
End If
Set treffer = Nothing
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

AW: Link auf Beispieldatei fehlt! o.T.
20.04.2017 12:48:55
Zoi
Hallo Matthias, :)
es funktioniert schneller, die Daten sind von alle drei Spalten überträgt , nur die Zahlen umwandlung fehlt noch da die Daten als text gespeichert sind und so wie sie sind sind überträgt. Die sollten erstmal in Zahl umgewandelt und dann übertragt.
Dankeschön !
AW: Link auf Beispieldatei fehlt! o.T.
20.04.2017 16:17:13
Matthias
Hallo! Dann probiere es mal so. Da wird das Blatt Gewicht geöffnet und dort für die Spalten K bis M das Zellformat auf Zahl gesetzt. Anschließend läuft der Code wieder wie vorher und kopierte die Werte. Alternativ könnte man auch nach dem Auslesen und Übertragen die Spalten CQ bis CS umformatieren.
VG

Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim treffer As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("PartList")
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets("gewicht")
'Formatierung in zahl
ws2.Columns("K:M").NumberFormat = "0"
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
Set treffer = ws1.Columns(3).Find(CStr(ws2.Cells(i, 3)), LookIn:=xlValues)
If Not treffer Is Nothing Then
findZeile = treffer.Row
ws2.Range(ws2.Cells(i, "K"), ws2.Cells(i, "M")).Copy ws1.Cells(findZeile, "CQ")
End If
Set treffer = Nothing
Next i
'das ist optional
'ws1.Columns("CQ:CR").NumberFormat = "0"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

AW: Link auf Beispieldatei fehlt! o.T.
21.04.2017 13:19:19
Zoi
Hallo wieder:),
ich habe es versucht wieder ,leider das format ist nicht geändert, es bleiben die grüne Dreiecks in die linke Ecke von jeder Zeile so wie Sie sind,und somit sind Sie kopiert auch.
Ich habe es versucht mit diesem code separat , nur in zahl Umwandlung und es geht, aber wenn ich das selbe in code rein haben will geht nicht.
 Dim LetzteZeile As Long
Dim i As Long
Dim s As Long
Dim spalten
spalten = Array(11, 12, 13) 'hier die Spaltennummern angeben
For s = 0 To UBound(spalten) - 1
LetzteZeile = Cells(Rows.Count, spalten(s)).End(xlUp).Row
For i = 2 To LetzteZeile
With Cells(i, spalten(s))
If .Value  "" Then
.Value = CDbl(.Value)
.NumberFormat = "General"
End If
End With
Next
Next
End Sub

AW: Link auf Beispieldatei fehlt! o.T.
21.04.2017 14:08:20
Zoi
Die andere Frage dazu ist, kann man den bestehenden code so umändern das man die entsprechende spalte nach Name in andere Spalte von andere Arbeitsmappe mit entsprechsende Name kopieren kann?
Zum Beispiel, wenn treffer gefunden ist, : K;L und M von wb2 ahben Namen Gew1,Gew2,Gew3, aber die Namen in wb2 sind anders wo die Werte reinkopiert sein sollten, also staht CQ,CR und CS, die sind Gew Gew3,Gew1 und GewGew2? Also die reichenfolge ist anders, und die entsprechende Wert soll kopiert sein in die richtige Spalte.
Viele Grüße!
Zoi
AW: Link auf Beispieldatei fehlt! o.T.
21.04.2017 20:13:08
matthias
Hallo! Probiere es mal so. Nun wird jede Zahl einzeln kopiert und das Format geändert (eigentlich). Zudem ist die Reihenfolge jetzt K in CR, L in CS und M in CQ (habe an Stelle der Spaltenbuchstaben die Zahlengenutzt also 95 bis 97). VG

Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim treffer As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("PartList")
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets("gewicht")
ws1.Columns("CQ:CR").NumberFormat = "0"
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
Set treffer = ws1.Columns(3).Find(CStr(ws2.Cells(i, 3)), LookIn:=xlValues)
If Not treffer Is Nothing Then
findZeile = treffer.Row
ws1.Cells(findZeile, 95) = CDbl(ws2.Cells(i, "M"))
ws1.Cells(findZeile, 96) = CDbl(ws2.Cells(i, "K"))
ws1.Cells(findZeile, 97) = CDbl(ws2.Cells(i, "L"))
End If
Set treffer = Nothing
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

AW: Link auf Beispieldatei fehlt! o.T.
23.04.2017 18:50:29
Zoi
Hallo Matthias, vielen vielen Dank, ist es Möglich diese Lösung so anzupassen das man nach dem Überschriften von Spalten die entsprechende werte kopieren kann?
Z.B dass staht 95,96,97 steht Überschriften wie " " "Werte 2""Werte 3", und staht K,L,M auch andere Überschriften wie " W1"," W5" und so weiter.? Ich habe es mit neue Variabeln ausprobiert und sieht so aus Z:B:
Dim Spalte1 As String
Dim Spn1 As String
Spn1 = "Werte1"
somit später kommt:
If ws1.Rows("1:1").Find(Spn1) Is Nothing Then
MsgBox Spn1 & " konnte nicht gefunden werden! Spaltennamen im Quellcode anpassen :-)"
Else
Spalte1 = Split(ws1.Rows("1:1").Find(Spn1).Address, "$")(1)
und so weiter für alle Spalten ist ziemlich lang......
bis :
ws1.Cells(findZeile, Spalte1) = CDbl(ws2.Cells(i, "K")) wobei Spalte1 ist definiert als Variable.
In den ws2 , woher die Daten kopiert sein sollten, sind auch andere Überschriften vorhanden, wobei wenn ich von K in andere variable umändern will kommt Fehler 13.
Gibt es andere Möglichkeit dass man nach Array suchen kann mit Überschriften?
Auch beim definition von lastrow :
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row , ist es hier Möglich staht C ein Überschrift zu stehen?
Danke, Viele Grüße,
Zoi
AW: Link auf Beispieldatei fehlt! o.T.
24.04.2017 13:13:45
Matthias
Moin! Also so könntest du die Spaltennamen zuordnen. Im array am Anfang mal zuordnen, wie die Spalten heißen sollen. Der Erste Eintrag ist immer der aus der Mappe gewicht (also wb2) und dahinter gleich der aus der aktuellen Mappe (wb1). So wie du die WErte hinschreibst wird auch eingetragen. So kannst du also auch festlegen, welche Spalte aus Gewicht in welche Spalte in der aktuellen Mappe soll. VG
Sub Transfer()
Dim i As Long, lastrow As Long, findZeile As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim treffer As Object
Dim zwei As Long
Dim eins As String
Dim anzahl As Long
Dim namen()
Dim index()
Dim bezug As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'hier die Zuordnung eintragen, erst den namen der Überschrift aus wb2 und dann das Gegenstück  _
hier
namen = Array("gew1", "gewicht1", "gew2", "gewicht2", "gew3", "gewicht3")
anzahl = UBound(namen)
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets(1)
Set wb2 = Workbooks.Open("C:\Desktop\Gewicht.xlsx")
Set ws2 = wb2.Sheets(1)
ReDim Preserve index(anzahl)
'Zuordnung finden
For i = 0 To anzahl Step 2
Set treffer = ws2.Rows(1).Find(namen(i), LookIn:=xlValues)
If Not treffer Is Nothing Then
index(i) = treffer.Column
Else
MsgBox "Die Spaltenummer wurde nicht gefunden! Programmende"
Exit Sub
End If
Set treffer = ws1.Rows(1).Find(namen(i + 1), LookIn:=xlValues)
If Not treffer Is Nothing Then
index(i + 1) = treffer.Column
Else
MsgBox "Der Spaltename wurde nicht gefunden! Programmende"
Exit Sub
End If
Next i
ws1.Columns("CQ:CR").NumberFormat = "0"
lastrow = ws2.Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
Set treffer = ws1.Columns(3).Find(CStr(ws2.Cells(i, 3)), LookIn:=xlValues)
If Not treffer Is Nothing Then
findZeile = treffer.Row
For bezug = 0 To anzahl Step 2
ws1.Cells(findZeile, index(bezug + 1)) = CDbl(ws2.Cells(i, CDbl(index(bezug))))
Next bezug
End If
Set treffer = Nothing
Next i
wb2.Close savechanges:=True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige