fork download
copy 
  1. Sub test1()    '比較sheet
  2.     Dim i As Long, j As Long  '比較シートa2:c5に貼り付け
  3.     Dim row3 As Long: row3 = 2
  4.     Sheets("比較").Rows("2:" & Rows.Count).ClearContents
  5.     With Sheets("sheet1").Range("a1").CurrentRegion.Offset(1, 0)
  6.         .Resize(.Rows.Count - 1).Copy Sheets("比較").Range("a2")
  7.     End With
  8.     i = 2
  9.     Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
  10.         Sheets("sheet2").Cells(i, "E") = ""
  11.         i = i + 2
  12.     Loop
  13.     Dim Flag As Long
  14.     i = 2
  15.     'Sheet1とSheet2にある商品を出力
  16.     Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
  17.         j = 2
  18.         Do Until j > Sheets("比較").Cells(Rows.Count, "a").End(xlUp).Row
  19.             If Sheets("比較").Cells(j, "a") = Sheets("sheet2").Cells(i, "a") Then
  20.                 Sheets("比較").Cells(row3, "d") = Sheets("sheet2").Cells(i, "a")
  21.                 Sheets("比較").Cells(row3, "e") = Sheets("sheet2").Cells(i, "b")
  22.                 Sheets("比較").Cells(row3, "f") = Sheets("sheet2").Cells(i, "c")
  23.                 Sheets("比較").Cells(j, "G") = "済"
  24.                 Sheets("sheet2").Cells(i, "E") = "済"
  25.                 row3 = row3 + 1
  26.                 Exit Do
  27.             End If
  28.             j = j + 1
  29.         Loop
  30.         i = i + 1
  31.     Loop
  32.     row3 = row3 + 3
  33.     i = 2
  34.     'Sheet2にのみある商品を出力
  35.     Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
  36.         If Sheets("sheet2").Cells(i, "E") = "" Then
  37.             Sheets("比較").Cells(row3, "d") = Sheets("sheet2").Cells(i, "a")
  38.             Sheets("比較").Cells(row3, "e") = Sheets("sheet2").Cells(i, "b")
  39.             Sheets("比較").Cells(row3, "f") = Sheets("sheet2").Cells(i, "c")
  40.             'Sheets("sheet2").Cells(i, "E") = ""
  41.             row3 = row3 + 1
  42.         End If
  43.         i = i + 1
  44.     Loop
  45.     'Sheet1にのみある商品を出力
  46.     j = 2
  47.     Do Until j > Sheets("比較").Cells(Rows.Count, "a").End(xlUp).Row
  48.         If Sheets("比較").Cells(j, "G") = "" Then
  49.             Sheets("比較").Cells(row3, "d") = Sheets("比較").Cells(j, "a")
  50.             Sheets("比較").Cells(row3, "e") = Sheets("比較").Cells(j, "b")
  51.             Sheets("比較").Cells(row3, "f") = Sheets("比較").Cells(j, "c")
  52.             'Sheets("比較").Cells(j, "G") = ""
  53.             row3 = row3 + 1
  54.         End If
  55.         j = j + 1
  56.     Loop
  57.     MsgBox ("完了")
  58. End Sub
  59.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/vHhYpn
language:
Text (text 6.10)
created:
1 year ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!