Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


48361 / 76736 ←次へ | 前へ→

【33311】Re:数字の比較について
回答  だるま WEB  - 06/1/8(日) 19:22 -

引用なし
パスワード
   こんな感じでしょうか。^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

0 hits

【33308】数字の比較について 超初心者 06/1/8(日) 17:21 質問
【33311】Re:数字の比較について だるま 06/1/8(日) 19:22 回答
【33313】Re:数字の比較について 超初心者 06/1/8(日) 20:57 お礼
【33314】Re:数字の比較について 超初心者 06/1/8(日) 21:41 質問
【33318】Re:数字の比較について Hirofumi 06/1/8(日) 22:53 回答

48361 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free