找到一定長度的單元格並複製到當前工作表中

我有一個帶有2個工作表的excel文件。找到一定長度的單元格並複製到當前工作表中

在工作表1中，我想最終列出工作表2中所有12位數字的單元格和右邊的單元格。
我想要在我的工作表1上的（允許說）I1的實際單元格（有12位數字的那個單元格）以及I2中它旁邊的值（在右邊）。

我想/我認爲我可以做一個循環來檢查什麼細胞是12位數字，但我有點迷路了。

經過一番更多搜尋我想出了這個：

Sub check() 
Dim rng As Range, cell As Range 

Set rng = Range("A1:P35") 

For Each cell In rng 

If Len(cell) = 12 Then 
    cell.Copy Destination:=Sheet2(s).Rows(K) 
    Row = K + 1 

End If 

Next cell 

End Sub

這個創意的工作？我還沒有想出如何將找到的單元格實際複製到其他工作表中。

來源

2015-09-06 Elmer

爲什麼要使用一個循環，而不是自動篩選？ [THIS]（http://superuser.com/questions/203521/how-to-filter-excel-data-by-text-length）和[THIS]（http://stackoverflow.com/questions/11631363/how在excel-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s）會讓你開始。 –

因爲我首先必須找到他們在工作表上的位置（並不總是相同的位置），然後將它們複製到新的工作表中。這不會只用一個過濾器我猜？ – Elmer

您可以遍歷列並應用自動過濾器？這種方式你可以一次照顧整個列:) –

對於單個列我會使用一個自動過濾（其西特推薦）或評估式中，對於2D範圍我寧願的變體。喜歡的東西：

Sub UseVariants() 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim X 
Dim Y 
Dim lngRow As Long 
Dim lngCol As Long 
Dim lngCnt As Long 

Set ws1 = Sheets(1) 
Set ws2 = Sheets(2) 

X = ws2.Range(ws2.[a1], ws2.[q35]).Value2 
ReDim Y(1 To UBound(X, 1) * UBound(X, 2), 1 To 2) 

For lngRow = 1 To UBound(X, 1) 
    'skip column Q 
    For lngCol = 1 To UBound(X, 2) - 1 
     If Len(X(lngRow, lngCol)) = 12 Then 
      lngCnt = lngCnt + 1 
      Y(lngCnt, 1) = X(lngRow, lngCol) 
      Y(lngCnt, 2) = X(lngRow, lngCol + 1) 
     End If 
    Next 
Next 

ws1.[i2].Resize(UBound(Y, 1), 2).Value2 = Y 
End Sub

來源

2015-09-06 13:32:07 brettdj

試試這個：

Sub Test() 
    Dim rng As Range, cl As Range, dic As Object, key, Rw& 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Set dic = CreateObject("Scripting.Dictionary") 
    Set ws1 = Sheets("Source"): Set ws2 = Sheets("Destination") 
    Rw = 1 
    With ws1 
     Set rng = .[A1:P35] 
     For Each cl In rng 
      If Len(cl) = 12 Then 
       dic.Add Rw, cl.Text & "|" & cl.Offset(, 1).Text '.text can be replaced by .value or omitted, depending on your needs 
       Rw = Rw + 1 
      End If 
     Next cl 
    End With 
    Rw = 1 'insert starting from row 1, change it if required 
    With ws2 
     For Each key In dic 
      .Cells(Rw, "A") = Split(dic(key), "|")(0) 
      .Cells(Rw, "B") = Split(dic(key), "|")(1) 
      Rw = Rw + 1 
     Next key 
    End With 
    Set dic = Nothing 
End Sub

來源

2015-09-06 14:13:46 Vasily

找到一定長度的單元格並複製到當前工作表中

回答

相關問題