我有一千行看起來像這樣的 Excel 作業表。
我在回圈中遇到了困難。我需要做的是從第一個單元格（即“002”）開始并選擇直到該單元格不等于第一個單元格（在本例中為“007”之前的單元格）。然后復制（或剪切，因為下一個回圈將從“007”開始）并將其粘貼到另一個作業簿。
我在這里有我現有的代碼。
Dim s_cell As Range
Dim c_cell As Range
Set s_cell = Range("AM2")
Do Until ActiveCell.Offset(1) <> s_cell
On Error Resume Next
c_cell = ActiveRange
Range(c_cell, AcitveCell.Offset(1)).Select
Loop
End Sub
如果我可以創建一個代碼來自動化這個想法，它將最大限度地減少這個作業量所需的時間。
uj5u.com熱心網友回復：
計算匹配的單元格數，ActiveCell如下所示：
Sub SelectActiveCellMatches()
If Len(ActiveCell) = 0 Then Exit Sub
Dim Count As Long
Do
Count = Count 1
Loop Until ActiveCell.Offset(Count).Value <> ActiveCell.Value
ActiveCell.Resize(Count).Select
End Sub
uj5u.com熱心網友回復：
部分自動化：復制列組
- 這會將與所選內容的第一個單元格相等的所有連續單元格復制到底部，但僅在選擇最后一個單元格下方的單元格之后。
Option Explicit
Sub CopyColumnGroup()
Const ProcName As String = "CopyColumnGroup"
On Error GoTo ClearError
With Selection.Cells(1)
Dim cCell As Range: Set cCell = .Cells
Dim cValue As Variant: cValue = .Value
Do While cCell.Value = cValue
Set cCell = cCell.Offset(1)
Loop
cCell.Select
.Resize(cCell.Row - .Row).Copy
End With
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub
uj5u.com熱心網友回復：
您可以回圈并檢查下一個值是否相同：
Sub test()
Dim i As Long
Dim j As Long
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
j = 2 'starting row of data
For i = 2 To LR Step 1
If Range("A" & i 1).Value <> Range("A" & i).Value Then
'next value is different, target range would be
Debug.Print Range("A" & j & ":A" & i).Address
j = i 1
End If
Next i
End Sub
這段代碼的輸出是：
$A$2:$A$5
$A$6:$A$7
$A$8
$A$9:$A$11
這些是您要復制或做任何您想做的值的連續范圍。請注意，即使該值只出現一次，它也可以作業。要呼叫目標范圍，請使用代碼中的Range("A" & j & ":A" & i). 這將采用所有以相同值開始和結束的連續單元格。
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/448406.html
下一篇：vba中正則運算式模式的可選部分