Suche und Aktualisierung in eine einzige Zelle

Question

Ich bin neu in VBA Excel, eine Woche alt. Ich habe wenig Ahnung in C, damit habe ich ein Programm erstellt.

Die Aufgabe besteht darin, dass „eine particluar Anzahl in einer Excel-Arbeitsblatt (1) zu suchen und in einem anderen Arbeitsblatt (2) vergleichen, die corrosponding coloumn Daten erhalten, concatinate die Informationen in einmal Zelle auf Arbeitsblatt (1).

ich habe versucht, aber ich kann nicht der Prozess ich brauche einen wertvollen Vorschlag getan, wie mein Code zu beheben

Mein Code:.

Sub test1() 
Dim iComp 
Worksheets("BSM_STF_iO").Select 
LastRow = Range("A" & Rows.Count).End(xlUp).Row 
For i = 2 To LastRow 

     a = onlyDigits(Range("A" & i).Value) 
     If InStr(a, "T") Then 
     Else 

    Worksheets("Tabelle1").Select 
     destlastrow = Range("B" & Rows.Count).End(xlUp).Row 
     For j = 2 To destlastrow 
     b = onlyDigits(Range("B" & j).Value) 
      iComp = StrComp(a, b, vbBinaryCompare) 
     Select Case iComp 
     Case 0 
Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(j, 3), Sheets("Tabelle1").Cells(j, 4)).Copy 
Sheets("Tabelle1").Activate 
erow = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Sheets("Tabelle1").Range(Cells(erow, 8), Cells(erow, 9)) 
Sheets("BSM_STF_iO").Activate 
End Select 
     Next j 


    End If 

Next i 
End Sub 
Function onlyDigits(s As String) As String 
    Dim retval As String 
    Dim i As Integer 
    retval = "" 
       retval = s 
     onlyDigits = retval 
End Function 

Beispiel:

Ich brauche von "Tabelle1" Arbeitsblatt Informationen von "10000" bis "BSM_STF_io" 10000.

BSM_STF_io
Tabellle1

Answer 1

alle Informationen, setzen Sie fest, ob das hilft (Ich entfernte die .Activate/.Select Teile):

Sub test1() 
Dim iComp 
Dim bsmWS As Worksheet, tabWS As Worksheet 

Set bsmWS = Sheets("BSM_STF_iO") 
Set tabWS = Sheets("Tabelle1") 

LastRow = bsmWS.Range("A" & bsmWS.Rows.Count).End(xlUp).Row 
For i = 2 To LastRow 
    a = onlyDigits(bsmWS.Range("A" & i).Value) 
    If InStr(a, "T") Then 
    ' do something? 
    Else 
     destlastrow = tabWS.Range("B" & tabWS.Rows.Count).End(xlUp).Row 
     For j = 2 To destlastrow 
      b = onlyDigits(tabWS.Range("B" & j).Value) 
      iComp = StrComp(a, b, vbBinaryCompare) 
      Select Case iComp 
      Case 0 
       With tabWS 
        erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
        .Range(.Cells(j, 3), .Cells(j, 4)).Copy .Range(.Cells(erow, 8), .Cells(erow, 9)) 
       End With  'tabWS 
      End Select 
     Next j 
    End If 

Next i 
End Sub 

In Ihrem ursprünglichen Code, manchmal haben Sie korrekt die Blätter für den Bereich, aber andere Male nicht (Sie sollten Sheets("whatever").Rows.Count auch verwenden). Dies wird hoffentlich die Arbeit straffen und für Sie arbeiten.