fork download
copy 
  1. Option Explicit
  2. Public Sub 重複データ抽出()
  3.     Dim sh1 As Worksheet
  4.     Dim sh2 As Worksheet
  5.     Dim sh3 As Worksheet
  6.     Dim maxrow1 As Long
  7.     Dim row3 As Long
  8.     Dim row31 As Long
  9.     Dim row2 As Long
  10.     Dim key As String
  11.     Dim old_key As String
  12.     Set sh1 = Worksheets("Sheet1")
  13.     Set sh2 = Worksheets("Sheet2")
  14.     Set sh3 = Worksheets("作業用")
  15.     sh2.Cells.ClearContents
  16.     sh3.Cells.ClearContents
  17.     maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
  18.     sh2.Cells(1, 1).Resize(1, 13).Value = sh1.Cells(1, 1).Resize(1, 13).Value
  19.     sh3.Cells(1, 1).Resize(maxrow1 - 1, 13) = sh1.Cells(2, 1).Resize(maxrow1 - 1, 13).Value
  20.     sh3.Range("A1:M" & maxrow1 - 1).Sort key1:=sh3.Range("A1"), Order1:=xlAscending, key2:=sh3.Range("B1"), Order1:=xlAscending, Header:=xlNo
  21.     old_key = ""
  22.     row2 = 2
  23.     For row3 = 1 To maxrow1 - 1
  24.         key = sh3.Cells(row3, 1).Value & "|" & sh3.Cells(row3, 2).Value
  25.         If key = old_key Then
  26.             If row31 <> 0 Then
  27.                 sh2.Cells(row2, 1).Resize(1, 13).Value = sh3.Cells(row31, 1).Resize(1, 13).Value
  28.                 row31 = 0
  29.                 row2 = row2 + 1
  30.             End If
  31.             sh2.Cells(row2, 1).Resize(1, 13).Value = sh3.Cells(row3, 1).Resize(1, 13).Value
  32.             row2 = row2 + 1
  33.         Else
  34.             row31 = row3
  35.         End If
  36.         old_key = key
  37.     Next
  38.     MsgBox ("完了")
  39. End Sub
  40.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/14Kmqj
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!