我需要將動態范圍的行復制并粘貼到同一作業簿中的硬編碼位置。將根據條件邏輯復制一行。本質上，邏輯是，如果此特定單元格的值 = Law，則取該行和向右偏移 5 個位置的列，并將其粘貼到特定范圍內。我遇到的問題是我的邏輯只是復制和粘貼一列并將其粘貼到指定范圍內，但是，我的 For Each 回圈中的每一行都會覆寫先前存在的值。此外，我的代碼不會復制到第一列之外，當我還希望復制這些值時，第二列將被忽略。我需要將每個新添加的行粘貼到下一個空單元格中。以下是我目前正在使用的邏輯：
Dim start_range As Range
Set start_range = ws.Range("A2")
Dim end_range As Range
ws.Activate
start_range.End(xlDown).Select
Set end_range = ActiveCell
Dim total_range As Range
Set total_range = Range(start_range, end_range)
For Each x In total_range
If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
x.Copy ws.Range("A10")
x.Offset(5, 0).Copy ws.Range("B10")
End If
Next
附加影像的最上面的列顯示了我將從中提取的資料源，底部顯示了我希望在清理代碼后看到的結果。讓我知道是否需要進一步澄清。
我之前嘗試添加一個額外的 For Each 回圈，它將占用我需要的第二列，但是，這似乎效率不高，而且我覺得事務可以在同一個 For Each 回圈中完成，但是，我很難過如何做到這一點。
通過 Toddleson 更新代碼（仍需要調整）
Dim wb As Workbook
Set wb = ThisWorkbook
Dim start_range As Range
Set start_range = wb.Sheets(1).Range("A2")
Dim end_range As Range
Set end_range = start_range.End(xlDown)
Dim total_range As Range
Set total_range = wb.Sheets(1).Range(start_range, end_range)
For Each x In total_range
If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
x.Copy wb.Sheets(1).Cells(10 Count, 1)
Count = Count 1
x.Offset(0, 5).Copy wb.Sheets(1).Cells(2, 10 Count, 1)
End If
Next
uj5u.com熱心網友回復：
根據條件復制資料 ( For Each...Next)
Option Explicit
Sub CopyFilteredData()
' Workbook, Worksheet
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
' Source
' Source Range (has headers)
' (the resize part means include only first 6 columns)
Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion ' .Resize(, 6)
' Source Data Range (data without headers)
Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
' Destination
' Destination First Cell (the 3 means 4 rows below the last row)
Dim dfCell As Range: Set dfCell = srg.Cells(1).Offset(srg.Rows.Count 3)
' To copy to another worksheet instead you could e.g. do:
'Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
'Dim dfCell As Range: Set dfCell = dws.Range("A2")
' Loop and copy.
Dim rrg As Range ' Current Row (Range)
' Loop through the rows of the data range (no headers).
For Each rrg In sdrg.Rows
Select Case CStr(rrg.Cells(1).Value) ' 'CStr' also avoids errors
Case "Law School Debt/Loan.", "Law" ' the comma means 'Or'
rrg.Copy dfCell ' copy row and paste starting with 'dfCell'
Set dfCell = dfCell.Offset(1) ' reference the (next) cell below
End Select
Next rrg
' Inform.
MsgBox "Filtered data copied.", vbInformation
End Sub
uj5u.com熱心網友回復：
您正在做Offset(5,0)的是將單元格放在下面 5 行x。如果您想在 x 旁邊獲得 5 列，則需要Offset(0,5)
如果您希望單元格不相互覆寫，那么您不能將“A10”和“B10”寫為靜態值。您需要添加一些計數器或變數，以便在粘貼值時移動地址。嘗試將“A10”行更改為x.Copy ws.Cells(10 Count, 1)然后Count = Count 1復制粘貼后進行。當然，還要更改“B10”行。
Sub Example()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets(1)
Dim start_range As Range
Set start_range = ws.Range("A2")
Dim end_range As Range
Set end_range = start_range.End(xlDown)
Dim total_range As Range
Set total_range = ws.Range(start_range, end_range)
Dim Cell As Range, Count As Long
For Each Cell In total_range.Cells
If Cell.Value = "Law School Debt/Loan." Or Cell.Value = "Law" Then
Cell.Copy ws.Cells(10 Count, 1)
Cell.Offset(0, 5).Copy ws.Cells(10 Count, 2)
Count = Count 1
End If
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/449928.html
上一篇：該作業簿中的宏可能不可用