Excel宏最近邻居

问题描述：

我有4张工作表的Microsoft Excel文档。每张纸中有21行和大约500列。我正在尝试编写一个最近邻函数来填充这些表中具有特定值的所有单元格。Excel宏最近邻居

实施例的行数据布局：

25 41 54 54 XX 41 54 XX XX XX 54 14

23 88 33 XX 41 54 XX 87 48 65 77 14

我需要检查所有数据，并用最近的行邻居替换XX。我想这可以通过嵌套for循环遍历每个值（每行中的每列）并查看当前单元格是否为XX来完成。如果是这样，它应该抓住没有XX值的最近的邻居。

为了澄清，当你说 “最近排的邻居”，你的意思是在同一行内最接近的值？即忽略任何可能更接近垂直的邻居？另外，您想如何解决多个最近邻居的情况，例如您的示例中的第一个“XX”？ – ikh 2013-03-14 21:08:38

很酷的问题，但你必须更具体地说明你的意思是“最近邻居” - XX的末端怎么样（左/右/上/下 - 取决于你如何定义最近的邻居） – 2013-03-14 21:18:40

我的道歉，我的意思是最近的邻居。有些情况下，在开始和结束时有XXXX，在这些情况下，我想让它们由行中最接近的非X值填充 – user1574832 2013-03-16 01:50:12

答

我会试试这个......但请记住，由于您没有回应澄清请求，所以这可能不是您想到的。此外，我这样做没有访问运行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

答

试试下面的代码：

假设你的数据是像下面的图像。

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

Excel宏最近邻居

相关推荐