VBA - Problem bei Ausführung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: VBA - Problem bei Ausführung
von: Linke
Geschrieben am: 19.10.2015 08:27:04

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

Bild

Betrifft: AW: VBA - Problem bei Ausführung
von: Hajo_Zi
Geschrieben am: 19.10.2015 08:46:55
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


Bild

Betrifft: AW: VBA - Problem bei Ausführung
von: hary
Geschrieben am: 19.10.2015 08:55:42
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA - Problem bei Ausführung"