Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1452to1456
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

VBA - Problem bei Ausführung

VBA - Problem bei Ausführung
19.10.2015 08:27:04
Linke
Hallo Community,
ich versuche seit längerem meinen Code zum Laufen bekommen. Leider "hängt" sich mein Computer bereits nach kurzer Zeit auf.
Ziel meines kleinen Programms ist, dass ich eine Spalte in mehreren Tabellen (35) mit einer Spalte in einer Referenztabelle vergleiche. Stellt sich ein Vergleich als wahr heraus, dann sollen Informationen aus der Referenztabelle in die jeweilige Tabelle kopiert werden. (Siehe Skript)
Ich hoffe Ihr findet den/die Fehler.
Freundliche Grüße
Christian Linke
____________________________________________________________________________________
Sub Main()
Dim a, b  As Integer
Dim vergleich1, vergleich2 As String
Dim i As Integer
Dim m As String
m = 0
For i = 1 To Sheets.Count
For a = 4 To 12
For b = 1 To 20
Sheets(1).Select
vergleich = Cells(a, 4)
Sheets(35).Select
vergleich2 = Cells(b, 14)
If vergleich = vergleich2 Then
Sheets(35).Select
Cells(b + 1, 2).Select
Selection.Copy
Sheets(i).Select
Cells(a + 1, 25).PasteSpecial
Sheets(35).Select
Cells(b + 1, 3).Select
Selection.Copy
Sheets(i).Select
Cells(a + 1, 26).PasteSpecial
Sheets(35).Select
Cells(b + 1, 5).Select
Selection.Copy
Sheets(i).Select
Cells(a + 1, 27).PasteSpecial
End If
m = m + 1
If m > 334600 Then
MsgBox "error"
GoTo limit
End If
Next b
Next a
Next i
limit:
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Problem bei Ausführung
19.10.2015 08:46:55
Hajo_Zi
arbeite ohne Select.
#Ich baue keine Datei nach.
Ich würde vermuten so
Option Explicit
Sub Main()
Dim a, b  As Integer
Dim vergleich As String, vergleich2 As String
Dim i As Integer
Dim m As String
m = 0
For i = 1 To Sheets.Count
For a = 4 To 12
For b = 1 To 20
vergleich = Sheets(1).Cells(a, 4)
vergleich2 = Sheets(35).Cells(b, 14)
If vergleich = vergleich2 Then
Sheets(35).Cells(b + 1, 2).Copy Sheets(i).Cells(a + 1, 25)
Sheets(35).Cells(b + 1, 3).Copy Sheets(i).Cells(a + 1, 26)
Sheets(35).Cells(b + 1, 5).Copy Sheets(i).Cells(a + 1, 27)
End If
m = m + 1
If m > 334600 Then
MsgBox "error"
Exit Sub
End If
Next b
Next a
Next i
End Sub

Anzeige
AW: VBA - Problem bei Ausführung
19.10.2015 08:55:42
hary
Moin
Evtl. kann man die 2. Schleife durch Find ersetzen.
Und statt kopieren nur die Werte uebertragen mit:
Sheets(i).Cells(a + 1, 25).Resize(1, 2).Value = Sheets(35).Cells(b + 1, 2).Resize(1, 2).Value
Sheets(i).Cells(a + 1, 27).Value = Sheets(35).Cells(b + 1, 5).Value

Dim a As Long, b  As Long, m As Long
Dim vergleich1 As String, vergleich2 As String
Dim i As Integer
m = 0
For i = 1 To Sheets.Count
For a = 4 To 12
For b = 1 To 20
vergleich = Sheets(1).Cells(a, 4)
vergleich2 = Sheets(35).Cells(b, 14)
If vergleich = vergleich2 Then
Sheets(35).Cells(b + 1, 2).Resize(1, 2).Copy Sheets(i).Cells(a + 1, 25)
Sheets(35).Cells(b + 1, 5).Copy Sheets(i).Cells(a + 1, 27)
End If
m = m + 1
If m > 334600 Then '---warum?
MsgBox "error"
GoTo limit
End If
Next b
Next a
Next i
limit:

gruss hary
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige