你們所有人都提供了很大的幫助，但它仍然沒有移動任何數字。我添加了另一個螢屏截圖。我需要查找藍色文本，如果找到，將 X 列中的數量向右移動兩列，直到在列 AI 中具有值的行。如螢屏截圖所示，每個條目的差距可能不同。可能是 2 或 4 或 5，只取決于列 AI。此外，第一個條目可能并不總是像這里那樣從同一行開始。在整個電子表格中，W 列和 AI 列中的位置可能不同。希望這有助于定義我的目的。
uj5u.com熱心網友回復：
試試這個：
Sub tester()
Dim c As Range, ws As Worksheet, rw As Range
Set ws = ActiveSheet 'always use an explicit sheet reference
For Each c In ws.Range("W2:W1000").Cells
Set rw = c.EntireRow 'the whole row for the cell
If c.Value = "Credit Adj W/O To Collection" And _
IsNumeric(rw.Columns("X").Value) Then
'copy the value to Col Y in the row above which has a value in Col AI
ws.Cells(rw.Columns("AI").End(xlUp).Row, "Y").Value = rw.Columns("X").Value
rw.Columns("X").ClearContents ' clear the "X" value
End If
Next c
End Sub
uj5u.com熱心網友回復：
一個棘手的專欄更新
- 回圈 (
r = r 1) 從第一行到最后一行（后者在列中計算W）。 - 當列
AI不為空時，將行號寫入變數 (rFound)。 - 繼續回圈 (
r = r 1)。當 columnW等于 string 時Credit Adj W/O To Collection，X將當前行列中的值寫入Y變數 (rFound) 中保存的行列中。 r = r 1通過在步驟 2. 和 3. 之間交替來繼續回圈 ( ) 直到最后一行。
Option Explicit
Sub UpdateInsAmt()
Const wsName As String = "Sheet1"
Const rStart As Long = 4
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim rLast As Long: rLast = ws.Cells(ws.Rows.Count, "W").End(xlUp).Row
Dim r As Long: r = rStart
Dim rFound As Long
Do
If Len(CStr(ws.Cells(r, "AI").Value)) > 0 Then ' is not blank
rFound = r
r = r 1 ' it can't be in the same row
Do
If StrComp(CStr(ws.Cells(r, "W").Value), _
"Credit Adj W/O To Collection", vbTextCompare) = 0 Then
ws.Cells(rFound, "Y").Value = ws.Cells(r, "X").Value
Exit Do ' value found and written so stop looping ...***
'Else ' value not found ...
End If
r = r 1 ' ... so incremenet row
Loop Until r > rLast
' Else ' is blank ...
End If
r = r 1 ' ... so increment row, ...*** and increment row
Loop Until r > rLast
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/380361.html