|
こんな感じでしょうか。^d^
(両列とも昇順に並べ替え済という前提です。)
Sub シンクロ()
Dim rngA As Range, rngB As Range
Dim AA As Variant, BB As Variant
Dim cA As Long, cB As Long, C As Long
Dim cAmax As Long, cBmax As Long
Dim Dest As Variant
Dim A As Variant, B As Variant
With Worksheets("Sheet1")
Set rngA = .Range("A1", .Range("A65536").End(xlUp))
End With
With Worksheets("Sheet2")
Set rngB = .Range("A1", .Range("A65536").End(xlUp))
End With
AA = rngA.Value: BB = rngB.Value
cAmax = UBound(AA): cBmax = UBound(BB)
ReDim Dest(1 To cAmax + cBmax, 1 To 3)
cA = 1: cB = 1: C = 1
Do Until cA > cAmax Or cB > cBmax
A = AA(cA, 1): B = BB(cB, 1)
If A = B Then
Dest(C, 1) = A
cA = cA + 1
Dest(C, 2) = B
cB = cB + 1
Dest(C, 3) = 0
ElseIf A < B Then
Dest(C, 1) = A
cA = cA + 1
Dest(C, 3) = A
Else
Dest(C, 2) = B
cB = cB + 1
Dest(C, 3) = -B
End If
C = C + 1
Loop
Do Until cA > cAmax
A = AA(cA, 1)
Dest(C, 1) = A
cA = cA + 1
Dest(C, 3) = A
C = C + 1
Loop
Do Until cB > cBmax
B = BB(cB, 1)
Dest(C, 2) = B
cB = cB + 1
Dest(C, 3) = -B
C = C + 1
Loop
Worksheets("Sheet1").Range("A1").Resize(cAmax + cBmax, 3).Value = Dest
Set rngA = Nothing
Set rngB = Nothing
End Sub
|
|