2016-06-21 5 views
2

Ich habe eine Schleife erstellt, um nach einem beliebigen Wert mit "R" plus einem Sonderzeichen zu suchen, das 10 Zeichen lang ist und diese in das nächste Feld einfügt Zelle in Spalte 1 auf einem anderen Blatt. Ich muss jetzt diesen Code entwickeln, um alle Werte beginnend mit R auf Blatt2 zu kopieren und diese in Spalte 1 (A) auf Blatt1 einzufügen und jeden Wert beginnend mit einer numerischen Ziffer auf Blatt2 zu kopieren und in Spalte 4 (D) auf Blatt1 einzufügenSchleife durch Blatt 2 und kopiere bestimmte Werte in bestimmte Spalten auf Blatt 1

Der Wert "R" würde dem numerischen Wert zugeordnet werden. Zum Beispiel auf sheet2 könnte A1 R000000_01 und B1 sein (Wenn ein Wert vorhanden ist) 12345 diese beiden Bedarf könnte in A3 und D3 über

Das ist wie erwähnt kopiert werden, was ich bisher erschaffen:

EnvRange = "A2:R999" 

RowNo = 3 
For Each C In Worksheets("Sheet2").Range(EnvRange) 
If Len(C.Value) < 10 Then 
GoTo NextCell 
ElseIf Len(C.Value) < 11 Then 
Worksheets("Sheet1").Cells(RowNo, 1).Value = C 
RowNo = RowNo + 1 
Else 
Chars = InStr(1, C, "R") 
Do While Chars < Len(C) 
Worksheets("Sheet1").Cells(RowNo, 1).Value = Mid(C, Chars, 10) 
Chars = InStr(Chars + 9, C, "R") 
RowNo = RowNo + 1 
If Chars = 0 Then GoTo NextCell 

Loop 
End If 

NextCell: Next C 

Ihre Hilfe in dieser Angelegenheit würde sehr geschätzt werden. Vielen Dank im Voraus.

Antwort

3

Sie können Like das Format überprüfen:

Sub Tester() 

    Const ENV_RNG As String = "A2:R999" 

    Dim c As Range, RowNo As Long, sht As Worksheet 

    Set sht = Worksheets("Sheet1") 
    RowNo = 3 

    For Each c In Worksheets("Sheet2").Range(EnvRange) 
     If c.Value Like "R?????????" Then 
      sht.Cells(RowNo, 1).Value = c.Value 
      sht.Cells(RowNo, 4).Value = c.Offset(0, 1).Value 
      RowNo = RowNo + 1 
     End If 
    Next c 

End Sub 
+0

Ich habe eine sehr ähnliche Unter habe, die ich verwende, um Daten und Stellenwerte entsprechend die 'For Each c In ...' Methode zu überprüfen, und es funktioniert einwandfrei – Vbasic4now

+0

Ausgezeichnet! Danke @Tim Williams! Das hat wie ein Zauber funktioniert! – Paul

Verwandte Themen