Выравнивание Соответствующие ячейки в excel (vbs, macro)

Question

Обновление (новая проблема) Этот код автоматически изолирует те, у которых нет совпадений. Но есть ли способ изолировать те, которые соответствуют?

---

TL; DR версия Так, в основном, ниже код для сопоставления ячеек в Excel, но это не соответствует все, даже если некоторые из них на самом деле соответствуют Вот пример того, что происходит:

  A  B 
.... 
2383   一時間 
.... 
25498 一時間 

, когда это должно быть что-то вроде

  A  B 
.... 
2383  一時間 一時間  

---

Детали:

http://www.mediafire.com/download/q7ym8qb41ywri0c/Soverflow.txt Приложенный табуляцией текст для импорта в Excel.

Итак, я искал решение для выравнивания совпадающих ячеек в столбцах, но в дополнение к этому он должен также выравнивать другие ячейки в строке вместе с перемещенным. Я собираюсь использовать ячейки без любые совпадения для моих собственных целей.

Это работает для некоторых ячеек, но это не работает для других ячеек, поэтому я думал, что что-то не делает код.

Например, если вы запустите код, который вы увидите, что в ячейке B2383, есть 一時間 но если вы CTRL + F для других матчей, вы найдете его в ячейке A25498. Они должны были быть выровнены, как и другие матчи, но по какой-то странной причине это не так.

Я использую макросы неправильно? Я просто скопировал код в Developer> Macros> Create> Alt + Q, затем я запустил его.

Sub test() 
    Dim a, i As Long, ii As Long, w, x, n As Long 
    With Range("a3").CurrentRegion 
     a = .Value 
     .ClearContents 
     With CreateObject("Scripting.Dictionary") 
      For i = 1 To UBound(a, 1) 
       If a(i, 1) <> "" Then 
        If Not .exists(a(i, 1)) Then 
         Redim w(1 To UBound(a, 2)) 
         w(1) = a(i, 1): .Item(a(i, 1)) = w 
        End If 
       End If 
      Next 
      For i = 1 To UBound(a, 1) 
       If a(i, 2) <> "" Then 
        If Not .exists(a(i, 2)) Then 
         Redim w(1 To UBound(a, 2)) 
        Else 
         w = .Item(a(i, 2)) 
        End If 
        For ii = 2 To UBound(a, 2) 
         w(ii) = a(i, ii) 
        Next 
        .Item(a(i, 2)) = w 
       End If 
      Next 
      x = Application.Transpose(Application.Transpose(.items)) 
      n = .Count 
     End With 
     .Resize(n).Value = x 
    End With 
End Sub 

Кредиты тому парню, который сделал код.

Answer 1

Ваш текущий регион в начале кода не точен.

Удалить пустую строку и посмотреть, как все меняется.