エクセルの表で、同じ内容の行を結合したいのですが、一か所の列のみ結合をせずそのままにしておく必要があります。どなたかＶＢＡを教えていただけないでしょうか？
イメージとしては次のようになります。
a b c d e 1 g
a b c d e 2 g
a b c d e 3 g
これを下記のようにしたい
a b c d e 1 g
2
3
社内システムに入力されているデータをＣＳＶにて抽出しそれをエクセルで加工しているのですが、
aを物件番号とするとｂ～e,gは物件１件につき一個の項目が入っているのに対し、数字の部分のみ１件につき複数の内容が選択されているのです。そのため、データを抽出すると数字のセル部分以外もすべての行でデータが落ちてくるのです。
そこで、見やすくするために、１～３の内容以外の部分はセルを結合させたいのです。
ここでは３行にしていますが、１行のときもあれば７行くらいになっていることもあります。
列はすべて同じ数になりますが現段階では何列か覚えておりません。すみません。
説明が下手で申し訳ないのですが、わかっていただけるでしょうか？
私はＶＢＡを習い始めたばかりでまったくわからず、自分で作成することができませんでした。ネットで探したものをコピペしてみたりしたのですが、どうもうまくいかず・・・
でもなんとかしたいのです！
みなさんのお力をお借りしたいと思います。よろしくお願いします。
エクセルの表で、同じ内容の行を結合したいのですが、一か所の列のみ結合をせずそのままにしておく必要があります。どなたかＶＢＡを教えていただけないでしょうか？
イメージとしては次のようになります。
a b c d e 1 g
a b c d e 2 g
a b c d e 3 g
これを下記のようにしたい
a b c d e 1 g
2
3
社内システムに入力されているデータをＣＳＶにて抽出しそれをエクセルで加工しているのですが、
aを物件番号とするとｂ～e,gは物件１件につき一個の項目が入っているのに対し、数字の部分のみ１件につき複数の内容が選択されているのです。そのため、データを抽出すると数字のセル部分以外もすべての行でデータが落ちてくるのです。
そこで、見やすくするために、１～３の内容以外の部分はセルを結合させたいのです。
ここでは３行にしていますが、１行のときもあれば７行くらいになっていることもあります。
列はすべて同じ数になりますが現段階では何列か覚えておりません。すみません。
説明が下手で申し訳ないのですが、わかっていただけるでしょうか？
私はＶＢＡを習い始めたばかりでまったくわからず、自分で作成することができませんでした。ネットで探したものをコピペしてみたりしたのですが、どうもうまくいかず・・・
でもなんとかしたいのです！
みなさんのお力をお借りしたいと思います。よろしくお願いします。
エクセル２００３についてお尋ねします。
Ａ1には行番号にあたる変数が表示されるようになっています。
その変数によって選択するセルの範囲が変わるようにすることが目的でした。
「Ａ１の行番号の５～10列目を選択する」というマクロを
下記のような記述を行いましたが、※のところでエラーが出てしまい、問題がわからずにおります。
お手数ですが解決策をご教授ください。
Sub マクロ1()
Dim j As Integer
j = Range("A1")
Worksheets("Sheet1").Activate
Range(Cells(j, 5), Cells(j, 10)).Select ←※
End Sub
よろしくお願いいたします。
先日からこちらでいろいろ教えていただき、以下を行うマクロを書きました。
R列とY列の2行目以下（行数は不定、ただしA列の行数に一致します。）の各セルにかなり長文の文字列があります。
短いので50文字程度、長いのは1000文字を超えます。
この各セルを、Range("AG1:CG1,CN1:DF1") の検索語句リストに記載の文字列で検索をかけます。
同一セル内に同じ検索文字列が複数ある場合もありますし、どの検索文字列も存在しないセルもあります。
ヒットしたら、該当の検索対象セルと該当の検索語句がある検索語句リストのセルを薄黄色に着色します。
その際、該当の検索対象セルと同一行、かつ該当の検索語句がある検索語句リストのセルと同一列のセルに＋１をして出現数をカウントします。
ヒットしたら、該当の検索対象セル内の検索語句を着色し、太字にします。
着色は検索語句リストのRange("CN1")より右の語句でヒットした場合は青、そうでなければ赤です。.
私にはかなり複雑でしたが、なんとか完成しました。
エクセル2003でためしたところちゃんと動いてくれました。
ところが、同じデータをエクセル2000でためしたところ、最初の何回かはうまくいったのですが、その後
「実行時エラー’-2147417848 (80010108)':
'Font' メソッドは失敗しました: 'Characters' オブジェクト
というエラーが出るようになりました。（エラーにならない場合もあります。）
同じデータで試しているのにエラーが出たときに検索しているセルは一定ではありませんし、検索語句もまちまちです。
しかも、一旦エラーが発生すると、エクセルのセルが選択できなくなります。（スクロールはできます。）
おまけにファイルの終了はできますが、エクセル自体が終了できなくなり、タスクマネージャでエクセル終了させなくてはなりません。
何がいけないのでしょうか？
Sub Try111012()
Dim tgtC As Range, myWrd As Range, rng As Range, myC As Range
Dim r As Long, pos As Long
Dim t As Single
t = Timer
r = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得
Set tgtC = Range("(R:R,Y:Y) 2:" & r) '検索対象範囲
With tgtC
.Font.ColorIndex = xlAutomatic
.Font.FontStyle = "標準"
.Interior.ColorIndex = xlNone
End With
Range("(AG:DF) 2:" & r).ClearContents 'カウントクリア
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set myWrd = Range("AG1:CG1,CN1:DF1") '検索語句リスト
For Each myC In tgtC '各検索対象セル
flg = Not (flg)
Application.StatusBar = myC.Address(0, 0) & " を検索中" '検索セル表示
With myC
For Each rng In myWrd '各検索語句
pos = InStr(1, .Value, rng.Value) '発見位置
If pos > 0 Then 'ヒットしたら
.Interior.ColorIndex = 36 '対象セルを薄黄色に
rng.Interior.ColorIndex = 36 '検索語句セルを薄黄色に
End If
Do While pos > 0 '同じ語句が発見されてるかぎり
With .Characters(pos, Len(rng.Value)).Font 'ここでエラー！！
.Bold = True '検索語句を太字
.ColorIndex = IIf(rng.Column >= Range("CN1").Column, 5, 3) '着色（赤と青）
End With
Cells(.Row, rng.Column).Value = Cells(.Row, rng.Column).Value + 1 '語句カウント
pos = InStr(pos + 1, .Value, rng.Value) 'セル内検索位置移動
Loop '繰り返し
Next rng '次の検索語句へ
End With
Next myC '次の検索対象セルへ
Range("(CH:CH) 2:" & r).Formula = "=SUM(AG2:CG2)"
Range("(CM:CM) 2:" & r).Formula = "=SUM(CN2:DF2)"
Range("(CJ:CJ) 2:" & r).Formula = "=AND(CH2>0,CM2>0)"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print Timer - t
MsgBox "キーワードを検索して着色しました。" & _
vbNewLine & "出現数も調べました。"
Application.StatusBar = ""
End Sub
先日からこちらでいろいろ教えていただき、以下を行うマクロを書きました。
R列とY列の2行目以下（行数は不定、ただしA列の行数に一致します。）の各セルにかなり長文の文字列があります。
短いので50文字程度、長いのは1000文字を超えます。
この各セルを、Range("AG1:CG1,CN1:DF1") の検索語句リストに記載の文字列で検索をかけます。
同一セル内に同じ検索文字列が複数ある場合もありますし、どの検索文字列も存在しないセルもあります。
ヒットしたら、該当の検索対象セルと該当の検索語句がある検索語句リストのセルを薄黄色に着色します。
その際、該当の検索対象セルと同一行、かつ該当の検索語句がある検索語句リストのセルと同一列のセルに＋１をして出現数をカウントします。
ヒットしたら、該当の検索対象セル内の検索語句を着色し、太字にします。
着色は検索語句リストのRange("CN1")より右の語句でヒットした場合は青、そうでなければ赤です。.
私にはかなり複雑でしたが、なんとか完成しました。
エクセル2003でためしたところちゃんと動いてくれました。
ところが、同じデータをエクセル2000でためしたところ、最初の何回かはうまくいったのですが、その後
「実行時エラー’-2147417848 (80010108)':
'Font' メソッドは失敗しました: 'Characters' オブジェクト
というエラーが出るようになりました。（エラーにならない場合もあります。）
同じデータで試しているのにエラーが出たときに検索しているセルは一定ではありませんし、検索語句もまちまちです。
しかも、一旦エラーが発生すると、エクセルのセルが選択できなくなります。（スクロールはできます。）
おまけにファイルの終了はできますが、エクセル自体が終了できなくなり、タスクマネージャでエクセル終了させなくてはなりません。
何がいけないのでしょうか？
Sub Try111012()
Dim tgtC As Range, myWrd As Range, rng As Range, myC As Range
Dim r As Long, pos As Long
Dim t As Single
t = Timer
r = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得
Set tgtC = Range("(R:R,Y:Y) 2:" & r) '検索対象範囲
With tgtC
.Font.ColorIndex = xlAutomatic
.Font.FontStyle = "標準"
.Interior.ColorIndex = xlNone
End With
Range("(AG:DF) 2:" & r).ClearContents 'カウントクリア
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set myWrd = Range("AG1:CG1,CN1:DF1") '検索語句リスト
For Each myC In tgtC '各検索対象セル
flg = Not (flg)
Application.StatusBar = myC.Address(0, 0) & " を検索中" '検索セル表示
With myC
For Each rng In myWrd '各検索語句
pos = InStr(1, .Value, rng.Value) '発見位置
If pos > 0 Then 'ヒットしたら
.Interior.ColorIndex = 36 '対象セルを薄黄色に
rng.Interior.ColorIndex = 36 '検索語句セルを薄黄色に
End If
Do While pos > 0 '同じ語句が発見されてるかぎり
With .Characters(pos, Len(rng.Value)).Font 'ここでエラー！！
.Bold = True '検索語句を太字
.ColorIndex = IIf(rng.Column >= Range("CN1").Column, 5, 3) '着色（赤と青）
End With
Cells(.Row, rng.Column).Value = Cells(.Row, rng.Column).Value + 1 '語句カウント
pos = InStr(pos + 1, .Value, rng.Value) 'セル内検索位置移動
Loop '繰り返し
Next rng '次の検索語句へ
End With
Next myC '次の検索対象セルへ
Range("(CH:CH) 2:" & r).Formula = "=SUM(AG2:CG2)"
Range("(CM:CM) 2:" & r).Formula = "=SUM(CN2:DF2)"
Range("(CJ:CJ) 2:" & r).Formula = "=AND(CH2>0,CM2>0)"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print Timer - t
MsgBox "キーワードを検索して着色しました。" & _
vbNewLine & "出現数も調べました。"
Application.StatusBar = ""
End Sub
先日からこちらでいろいろ教えていただき、以下を行うマクロを書きました。
R列とY列の2行目以下（行数は不定、ただしA列の行数に一致します。）の各セルにかなり長文の文字列があります。
短いので50文字程度、長いのは1000文字を超えます。
この各セルを、Range("AG1:CG1,CN1:DF1") の検索語句リストに記載の文字列で検索をかけます。
同一セル内に同じ検索文字列が複数ある場合もありますし、どの検索文字列も存在しないセルもあります。
ヒットしたら、該当の検索対象セルと該当の検索語句がある検索語句リストのセルを薄黄色に着色します。
その際、該当の検索対象セルと同一行、かつ該当の検索語句がある検索語句リストのセルと同一列のセルに＋１をして出現数をカウントします。
ヒットしたら、該当の検索対象セル内の検索語句を着色し、太字にします。
着色は検索語句リストのRange("CN1")より右の語句でヒットした場合は青、そうでなければ赤です。.
私にはかなり複雑でしたが、なんとか完成しました。
エクセル2003でためしたところちゃんと動いてくれました。
ところが、同じデータをエクセル2000でためしたところ、最初の何回かはうまくいったのですが、その後
「実行時エラー’-2147417848 (80010108)':
'Font' メソッドは失敗しました: 'Characters' オブジェクト
というエラーが出るようになりました。（エラーにならない場合もあります。）
同じデータで試しているのにエラーが出たときに検索しているセルは一定ではありませんし、検索語句もまちまちです。
しかも、一旦エラーが発生すると、エクセルのセルが選択できなくなります。（スクロールはできます。）
おまけにファイルの終了はできますが、エクセル自体が終了できなくなり、タスクマネージャでエクセル終了させなくてはなりません。
何がいけないのでしょうか？
Sub Try111012()
Dim tgtC As Range, myWrd As Range, rng As Range, myC As Range
Dim r As Long, pos As Long
Dim t As Single
t = Timer
r = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得
Set tgtC = Range("(R:R,Y:Y) 2:" & r) '検索対象範囲
With tgtC
.Font.ColorIndex = xlAutomatic
.Font.FontStyle = "標準"
.Interior.ColorIndex = xlNone
End With
Range("(AG:DF) 2:" & r).ClearContents 'カウントクリア
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set myWrd = Range("AG1:CG1,CN1:DF1") '検索語句リスト
For Each myC In tgtC '各検索対象セル
flg = Not (flg)
Application.StatusBar = myC.Address(0, 0) & " を検索中" '検索セル表示
With myC
For Each rng In myWrd '各検索語句
pos = InStr(1, .Value, rng.Value) '発見位置
If pos > 0 Then 'ヒットしたら
.Interior.ColorIndex = 36 '対象セルを薄黄色に
rng.Interior.ColorIndex = 36 '検索語句セルを薄黄色に
End If
Do While pos > 0 '同じ語句が発見されてるかぎり
With .Characters(pos, Len(rng.Value)).Font 'ここでエラー！！
.Bold = True '検索語句を太字
.ColorIndex = IIf(rng.Column >= Range("CN1").Column, 5, 3) '着色（赤と青）
End With
Cells(.Row, rng.Column).Value = Cells(.Row, rng.Column).Value + 1 '語句カウント
pos = InStr(pos + 1, .Value, rng.Value) 'セル内検索位置移動
Loop '繰り返し
Next rng '次の検索語句へ
End With
Next myC '次の検索対象セルへ
Range("(CH:CH) 2:" & r).Formula = "=SUM(AG2:CG2)"
Range("(CM:CM) 2:" & r).Formula = "=SUM(CN2:DF2)"
Range("(CJ:CJ) 2:" & r).Formula = "=AND(CH2>0,CM2>0)"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print Timer - t
MsgBox "キーワードを検索して着色しました。" & _
vbNewLine & "出現数も調べました。"
Application.StatusBar = ""
End Sub
エクセルで特定の列の2～10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか？あるいはもっといい方法があれば教えてください。
実際には列は約40列（固定）、行は1～2万行（変動）程度で、作業はもっと複雑です。
Sub test01()
Dim col
Dim i As Long, n As Long
For Each col In Array(1, 3, 7, 8, 11) '列番号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test02()
Dim col
Dim i As Long, n As Long
For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test03()
Dim col
Dim i As Long, n As Long
For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定
For i = 2 To 10
n = n + 1
col.Offset(i - 2).Value = n
Next i
Next col
End Sub
エクセルで特定の列の2～10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか？あるいはもっといい方法があれば教えてください。
実際には列は約40列（固定）、行は1～2万行（変動）程度で、作業はもっと複雑です。
Sub test01()
Dim col
Dim i As Long, n As Long
For Each col In Array(1, 3, 7, 8, 11) '列番号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test02()
Dim col
Dim i As Long, n As Long
For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test03()
Dim col
Dim i As Long, n As Long
For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定
For i = 2 To 10
n = n + 1
col.Offset(i - 2).Value = n
Next i
Next col
End Sub
エクセルで特定の列の2～10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか？あるいはもっといい方法があれば教えてください。
実際には列は約40列（固定）、行は1～2万行（変動）程度で、作業はもっと複雑です。
Sub test01()
Dim col
Dim i As Long, n As Long
For Each col In Array(1, 3, 7, 8, 11) '列番号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test02()
Dim col
Dim i As Long, n As Long
For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test03()
Dim col
Dim i As Long, n As Long
For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定
For i = 2 To 10
n = n + 1
col.Offset(i - 2).Value = n
Next i
Next col
End Sub
エクセルで特定の列の2～10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか？あるいはもっといい方法があれば教えてください。
実際には列は約40列（固定）、行は1～2万行（変動）程度で、作業はもっと複雑です。
Sub test01()
Dim col
Dim i As Long, n As Long
For Each col In Array(1, 3, 7, 8, 11) '列番号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test02()
Dim col
Dim i As Long, n As Long
For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定
For i = 2 To 10
n = n + 1
Cells(i, col).Value = n
Next i
Next col
End Sub
Sub test03()
Dim col
Dim i As Long, n As Long
For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定
For i = 2 To 10
n = n + 1
col.Offset(i - 2).Value = n
Next i
Next col
End Sub
お世話になります。エクセル初心者です。
i < j の関係があるときに、それぞれの数値をfor構文でループを回したいです。
ｉ の数値は外部から入力される前提です。
現在、以下のような構文を考えています(istartとiendは外部から決められた数値とします）が、
この場合、jendはiend + 1とすれば良いのですが、jstartはどのように入力すれば良いでしょうか？
修正箇所を指摘（もしくは全文修正）していただけると、非常に助かります。
よろしくお願いいたします。
Sub test()
Dim i As Integer
Dim j As Integer
Dim istart As Integer
Dim iend As Integer
Dim jstart As Integer
Dim jend As Integer
istart = 1
iend = 50
For i = istart To iend
For j = jstart To jend
'実行したい内容
Next
Next
End Sub
お世話になります。エクセル初心者です。
i < j の関係があるときに、それぞれの数値をfor構文でループを回したいです。
ｉ の数値は外部から入力される前提です。
現在、以下のような構文を考えています(istartとiendは外部から決められた数値とします）が、
この場合、jendはiend + 1とすれば良いのですが、jstartはどのように入力すれば良いでしょうか？
修正箇所を指摘（もしくは全文修正）していただけると、非常に助かります。
よろしくお願いいたします。
Sub test()
Dim i As Integer
Dim j As Integer
Dim istart As Integer
Dim iend As Integer
Dim jstart As Integer
Dim jend As Integer
istart = 1
iend = 50
For i = istart To iend
For j = jstart To jend
'実行したい内容
Next
Next
End Sub
シート（最初）のA,B,C列を連結した値と
シート（残）のA,B,C列を連結した値を照合させ
同じ値の場合は
シート（残）の該当行を削除です。
シート（最初）は6,182行
シート（残）は7,561行です。
VLookupを使って処理時間5分です。
VLookupを使わない記述で25分です。
20,000行位のデータを処理したいのですが時間が不安です。
別スレで
「VLookupで処理3分をdictionaryオブジェクトで1秒以内にする方法」を
教えていただきましたが、流用ができません。
シート（残）内にもシート（最初）内にも重複行はありません。
私の記述は「F列を検索用に使用」となっていて
F列にデータがある場合、都度記述を書換えないと
使えないので、そこも対応したいです。
照合させる値はA,B,Cの連結値というのは変わらないのですが
データがある範囲は都度変化する為です。
・A～E列とかA～H列とか
・シート残はA～E列、シート最初はA～G列とか
記述そのものを教えてください。よろしくお願いします。
Sub 自動重複削除F列使用()
'シート（最初）のA,B,C列とシート（残）のA,B,C列が一致した行は
'シート残の行を削除
'F列を検索値として使用。
Dim Line As Long
Dim LastRow As Long
Dim myRange As Range
Dim Flag
'シート「最初」のF1に、A,B,C列を結合した値を転記
With Sheets("最初")
Set myRange = .Range("F2:F" & .Cells(Rows.Count, "A").End(xlUp).Row)
.Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
.Range("F2").AutoFill Destination:=myRange
End With
'シート「残」のF1に、A,B,C列を結合した値を転記
Sheets("残").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)
On Error Resume Next
'双方のシートのF列を照合させ、ヒットした行は
'シート「残」から行削除をする
For Line = LastRow To 2 Step -1
Flag = WorksheetFunction.VLookup(Cells(Line, 6).Value, myRange, 1, 0)
If Err.Number = 0 Then
Rows(Line).Delete xlUp
Else
Err.Clear
End If
Next Line
'検索に使用したＦ列を削除
Sheets("残").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("最初").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("残").Select
Range("A1").Select
End Sub
●別方法
Sub 自動重複行削除F列未使用超遅()
'VLOOKUP無
'シート（最初）のA,B,C列とシート（残）の
'A,B,C列が一致した行はシート（残）の行を削除
Dim ws1, ws2 As Worksheet
Dim i, j As Long
Set ws1 = Worksheets("最初")
Set ws2 = Worksheets("残")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If ws1.Cells(i, 1) = ws2.Cells(j, 1) And ws1.Cells(i, 2) = ws2.Cells(j, 2) And _
ws1.Cells(i, 3) = ws2.Cells(j, 3) Then
ws2.Rows(j).Delete (xlUp)
End
シート（最初）のA,B,C列を連結した値と
シート（残）のA,B,C列を連結した値を照合させ
同じ値の場合は
シート（残）の該当行を削除です。
シート（最初）は6,182行
シート（残）は7,561行です。
VLookupを使って処理時間5分です。
VLookupを使わない記述で25分です。
20,000行位のデータを処理したいのですが時間が不安です。
別スレで
「VLookupで処理3分をdictionaryオブジェクトで1秒以内にする方法」を
教えていただきましたが、流用ができません。
シート（残）内にもシート（最初）内にも重複行はありません。
私の記述は「F列を検索用に使用」となっていて
F列にデータがある場合、都度記述を書換えないと
使えないので、そこも対応したいです。
照合させる値はA,B,Cの連結値というのは変わらないのですが
データがある範囲は都度変化する為です。
・A～E列とかA～H列とか
・シート残はA～E列、シート最初はA～G列とか
記述そのものを教えてください。よろしくお願いします。
Sub 自動重複削除F列使用()
'シート（最初）のA,B,C列とシート（残）のA,B,C列が一致した行は
'シート残の行を削除
'F列を検索値として使用。
Dim Line As Long
Dim LastRow As Long
Dim myRange As Range
Dim Flag
'シート「最初」のF1に、A,B,C列を結合した値を転記
With Sheets("最初")
Set myRange = .Range("F2:F" & .Cells(Rows.Count, "A").End(xlUp).Row)
.Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
.Range("F2").AutoFill Destination:=myRange
End With
'シート「残」のF1に、A,B,C列を結合した値を転記
Sheets("残").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)
On Error Resume Next
'双方のシートのF列を照合させ、ヒットした行は
'シート「残」から行削除をする
For Line = LastRow To 2 Step -1
Flag = WorksheetFunction.VLookup(Cells(Line, 6).Value, myRange, 1, 0)
If Err.Number = 0 Then
Rows(Line).Delete xlUp
Else
Err.Clear
End If
Next Line
'検索に使用したＦ列を削除
Sheets("残").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("最初").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("残").Select
Range("A1").Select
End Sub
●別方法
Sub 自動重複行削除F列未使用超遅()
'VLOOKUP無
'シート（最初）のA,B,C列とシート（残）の
'A,B,C列が一致した行はシート（残）の行を削除
Dim ws1, ws2 As Worksheet
Dim i, j As Long
Set ws1 = Worksheets("最初")
Set ws2 = Worksheets("残")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If ws1.Cells(i, 1) = ws2.Cells(j, 1) And ws1.Cells(i, 2) = ws2.Cells(j, 2) And _
ws1.Cells(i, 3) = ws2.Cells(j, 3) Then
ws2.Rows(j).Delete (xlUp)
End
