我剛學會在excel中使用VBA，我有一個如圖所示的電子表格，
我有來自 B1:B12 的列包含要搜索和移動的內容，我想構建代碼來搜索將 C13:AD31 范圍內的字符移動到 C1:AD12 范圍內的同一行。例如，在區域C13:AD31中，有一個子區域E14:J14包含內容“Vn”，與B2相同，然后將E14:J14移動（剪切 粘貼）到E2:J2，繼續回圈直到移動了區域 C13:AD31 中的所有字符（換句話說，A13:AD31 只留下了所有空單元格）。我想要的回圈將回傳如下所示的結果。
非常感謝您的幫助
uj5u.com熱心網友回復：
更新缺失資料
Option Explicit
Sub UpdateData()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim rg As Range
With ThisWorkbook.Worksheets("Sheet1").UsedRange
Set rg = .Resize(, .Columns.Count - 1).Offset(, 1)
End With
Dim cell As Range
Set cell = rg.Columns(1).Find("*", , xlValues, , , xlPrevious)
Dim drCount As Long: drCount = cell.Row - rg.Row 1
Dim cCount As Long: cCount = rg.Columns.Count - 1
Dim lrg As Range: Set lrg = rg.Cells(1).Resize(drCount) ' Lookup
Dim drg As Range: Set drg = lrg.Resize(, cCount).Offset(, 1) ' Destination
' Source
Dim srCount As Long: srCount = rg.Row rg.Rows.Count - cell.Row - 1
Dim srg As Range: Set srg = rg.Resize(srCount, cCount).Offset(drCount, 1)
Debug.Print lrg.Address, drg.Address, srg.Address, cCount
Application.ScreenUpdating = False
Dim srrg As Range
Dim sValue As Variant
Dim drIndex As Variant
Dim c As Long
For Each srrg In srg.Rows
If Application.CountBlank(srrg) < cCount Then
For c = 1 To cCount
sValue = srrg.Cells(c).Value
If Not IsError(sValue) Then
If Len(sValue) > 0 Then
drIndex = Application.Match(sValue, lrg, 0)
If IsNumeric(drIndex) Then
srrg.Cells(c).Copy drg.Cells(drIndex, c)
End If
End If
End If
Next c
End If
Next srrg
Application.ScreenUpdating = True
MsgBox "Data updated.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/449908.html