2013-03-14 139 views
0

我有4張工作表的Microsoft Excel文檔。每張紙中有21行和大約500列。我正在嘗試編寫一個最近鄰函數來填充這些表中具有特定值的所有單元格。Excel宏最近鄰居

實施例的行數據佈局:

  1. 25 41 54 54 XX 41 54 XX XX XX 54 14
  2. 23 88 33 XX 41 54 XX 87 48 65 77 14

我需要檢查所有數據,並用最近的行鄰居替換XX。我想這可以通過嵌套for循環遍歷每個值(每行中的每列)並查看當前單元格是否爲XX來完成。如果是這樣,它應該抓住沒有XX值的最近的鄰居。

+1

爲了澄清,當你說 「最近排的鄰居」,你的意思是在同一行內最接近的值?即忽略任何可能更接近垂直的鄰居?另外,您想如何解決多個最近鄰居的情況,例如您的示例中的第一個「XX」? – ikh 2013-03-14 21:08:38

+0

很酷的問題,但你必須更具體地說明你的意思是「最近鄰居」 - XX的末端怎麼樣(左/右/上/下 - 取決於你如何定義最近的鄰居) – 2013-03-14 21:18:40

+0

我的道歉,我的意思是最近的鄰居。有些情況下,在開始和結束時有XXXX,在這些情況下,我想讓它們由行中最接近的非X值填充 – user1574832 2013-03-16 01:50:12

回答

0

我會試試這個......但請記住,由於您沒有迴應澄清請求,所以這可能不是您想到的。此外,我這樣做沒有訪問運行VBA的機器,因此可能會有一兩個小錯誤。

Option Explicit 
sub fillNN() 
' we know there are five rows; number of columns is "approximate". 
dim thisRow as Integer 
dim s, c 
dim r, rLast as range 

for each s in WorkBook.WorkSheets 
    s.Activate 
    set r = Range("A1") 

    For thisRow = 1 To 5 
    set r = Range("A1").Offset(thisRow-1,0) 
    set rLast = r.End(xlToRight) ' find the last cell in the row 

    for each c in Range(r, rLast).cells 
     if c.Value = "XX" Then 
     c.Value = nearestNeighbor(c) 
     end if 
    next c 
    Next thisRow 

    ' the nearestNeighbor() function left the "XX" on the value 
    ' now we have to strip it: 
    For thisRow = 1 To 5 
    set r = Range("A1").Offset(thisRow-1,0) 
    set rLast = r.End(xlToRight) ' find the last cell in the row 

    for each c in Range(r, rLast).cells 
     if Left(c.Value, 2) = "XX" Then 
     c.Value = MID(c.Value, 3, len(c.Value)-2) 
     end if 
    next c 
    Next thisRow 

Next s 
End Sub 

Function nearestNeighbor(c as Range) 
' find the nearest "valid" cell: 
' look to the left and to the right; if nothing found, extend the range by 1 and repeat 
Dim rc, cc , dr, cs, s as Integer 
Dim lastCol as Integer 
Dim flag as Boolean 
flag = true 
s = 1 ' size of step 

lastCol = c.End(xlToRight).column 

' if c is the last cell, then the above will go to the end of the spreadsheet 
' since we know there are "about 500" columns, we can catch that easily: 
if lastCol > 1000 Then lastCol = c.column 

' make sure there is always a return value: 
nearestNeighbor = "XX" 
While (flag) 
    For dr = -1 To 1 Step 2 
    cs = c.column + dr * s 
    If Not(cs < 1 Or cs > lastCol) Then 
     If Not c.offset(dr * s, 0).Value = "XX" Then 
     flag = false 
     ' keep the "XX" in front so it won't become a "valid nearest neighbor" on next pass 
     nearestNeighbor = "XX" + c.offset(dr * s, 0).Value 
     Exit For 
     End If 
    End If 
    Next dr 
    s = s + 1 
    if s > lastCol Then flag = false 
End While 

End Function 
0

試試下面的代碼:

假設你的數據是像下面的圖像。

enter image description here

代碼:

Sub Sample() 
    Dim rng As Range 
    Set rng = Cells.Find("XX") 

    Do Until rng Is Nothing 
     rng.Value = rng.Offset(0, -1) 'Offset(0, -1) for left neighbour , Offset(0, 1) for right 
     Set rng = Cells.Find("XX") 
    Loop 
End Sub