Excel VBA質問箱 IV

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

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


1229 / 13645 ツリー ←次へ | 前へ→

【75555】マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 15:05 質問[未読]
【75556】Re:マクロで、同じ番号行だけを残す方法 カエムワセト 14/5/17(土) 18:01 発言[未読]
【75557】Re:マクロで、同じ番号行だけを残す方法 カエムワセト 14/5/17(土) 18:03 発言[未読]
【75558】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 19:39 発言[未読]
【75559】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 19:40 発言[未読]
【75560】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 19:46 回答[未読]
【75561】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 21:22 発言[未読]
【75562】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/17(土) 22:51 発言[未読]
【75563】Re:マクロで、同じ番号行だけを残す方法 Yuki 14/5/18(日) 8:42 発言[未読]
【75564】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/18(日) 10:13 発言[未読]
【75565】Re:マクロで、同じ番号行だけを残す方法 Yuki 14/5/18(日) 11:30 発言[未読]
【75566】Re:マクロで、同じ番号行だけを残す方法 カエムワセト 14/5/18(日) 11:44 発言[未読]
【75567】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/18(日) 15:22 発言[未読]
【75568】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/18(日) 15:36 発言[未読]
【75569】Re:マクロで、同じ番号行だけを残す方法 Yuki 14/5/18(日) 16:55 発言[未読]
【75571】Re:マクロで、同じ番号行だけを残す方法 ザ 焼鳥男 14/5/18(日) 20:33 お礼[未読]
【75572】Re:マクロで、同じ番号行だけを残す方法 γ 14/5/18(日) 22:25 発言[未読]

【75555】マクロで、同じ番号行だけを残す方法
質問  ザ 焼鳥男  - 14/5/17(土) 15:05 -

引用なし
パスワード
   こんにちは、
Excel VBA初心者です。よろしく御願いします。

以下のマクロを教えて下さい。 
1、まずsheet1とsheet2がありsheet2を、新たに、新しいsheetにコピーして、タグ名を、「result」にします。
sheet1は、2列以降に情報が入力、sheet2は、5列以降に情報が入力されています。
2、「result」のD列に、sheet1のB列(名前)をコピーします。
3、sheet1のA列とsheet2のB列の番号を、比較して、同じ番号だけを残します。
4、「result」のNoを、1から連番にします。

<<シート:sheet11>>
  A  B  C D
1  No. 名前 性別
2 A01 梅尾 女
3 A02 福田 男
4 B01 石川 女
5 B02 森田 男
 
<<シート:sheet2>>
 A  B   C   D E
1 
2 タイトル(10セルを結合)
3 番号 No. 住所 年齢 特徴
4 同上 同上 同上 同上 同上← 3と4のセルを結合

~ 1 A01 東京 19歳 国語が得意← 5〜19のセルを結合
19
20
~ 2 A02 鹿児島 19歳 国語、国語、英語、数学、運動が得意← 20〜34のセルを結合 
34
35
~ 3 A03 アメリカ 19歳 数学が得意← 35〜49のセルを結合
49
50
~ 4 A04 長野 19歳 数学が得意← 50〜64のセルを結合
64
 
 <<シート:result>>

 
  A  B   C   D  E F
1 
2 タイトル(12セルを結合)
3 番号 No. 住所 名前 年齢 特徴
4 同上 同上 同上 同上 同上 同上← 3と4のセルを結合

~ 1 A01 東京 梅尾 19歳 国語が得意← 5〜19のセルを結合
19
20
~ 2 A02 鹿児島 福田 19歳 国語、国語、英語、←改行させる
数学、運動が得意← 20〜34のセルを結合
34

【75556】Re:マクロで、同じ番号行だけを残す方法
発言  カエムワセト  - 14/5/17(土) 18:01 -

引用なし
パスワード
   まず、こちらをお読みください。

VBA質問箱基本ポリシー

tp://www.vbalab.net/bbspolicy.html

>何をやったか書いてください

>してはいけない質問について
>・丸投げ

【75557】Re:マクロで、同じ番号行だけを残す方法
発言  カエムワセト  - 14/5/17(土) 18:03 -

引用なし
パスワード
   よくみたらラーメンから焼き鳥に乗り換えただけでしたか。

【75558】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/17(土) 19:39 -

引用なし
パスワード
   ▼カエムワセト さん:
>よくみたらラーメンから焼き鳥に乗り換えただけでしたか。

そうですが、、、

【75559】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/17(土) 19:40 -

引用なし
パスワード
   よろしく御願い致します。

Sub macro1()
 Dim LastRow As Long
 LastRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

'結果シートを準備
 Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
 ActiveSheet.Name = "RESULT"

'ファイル1から転記、不要な行を抹消
 Range("C1:C" & LastRow).Formula = "=VLOOKUP(A1,Sheet1!A:B,2,FALSE)"
 On Error Resume Next
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
 Range("C1:C" & LastRow).Value = Range("C1:C" & LastRow).Value
End Sub

【75560】Re:マクロで、同じ番号行だけを残す方法
回答  ザ 焼鳥男  - 14/5/17(土) 19:46 -

引用なし
パスワード
   松    1
竹    2
梅    3
犬    4
Sheet1

松    月    1
竹    火    2
木    水    3
金    日    4
        
Sheet2

松    月    1
竹    火    2
        
Result

この場合なら、前のコードでうまく処理できます。

【75561】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/17(土) 21:22 -

引用なし
パスワード
   こんにちは、Excel VBA初心者です。よろしく御願いします。
ご回答が、御座いません。
多分、質問がごちゃごちしているためだと思いますので、修正します。

以下のマクロを教えて下さい。 
1、まずsheet1とsheet2がありsheet2を、新たに、新しいsheetにコピーして、タグ名を、「result」にします。
2、「result」のC列に、sheet1のB列(名前)をコピーします。
3、sheet1のA列とsheet2のB列の番号を、比較して、同じ番号だけを残します。
4、「result」のNoを、1から連番にします。
<<シート:sheet11>>
  A  B  C D
1  No. 名前 性別
2  A01 梅尾 女
3 A02 福田 男
4 B01 石川 女
5 B02 森田 男
<<シート:sheet2>>
 A B C  D E
1 タイトル(5セルを結合)
2 番号 No. 住所 年齢 得意科目
3  1 A01 東京 19歳 国語
4  2 A02 鹿児島 19歳 物理
5 3 A03 アメリカ 19歳 数学
6 4 A04 長野 19歳 数学
 <<シート:result>>
 A B C D E F
1 タイトル(6セルを結合)
2 番号 No. 名前 住所 年齢 得意科目
3 1 A01 梅尾 東京 19歳 国語
4 2 A02 福田 鹿児島 19歳 物理

【75562】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/17(土) 22:51 -

引用なし
パスワード
   こんにちは、
すいません。再度、質問を記載します。

マクロ手順
1、まずsheet1とsheet2がありsheet2を、新たに、新しいsheetにコピーして、タグ名を、「result」にします。
2、sheet1のA列とsheet2のB列の番号を、比較して、同じ番号だけを残します。
3、「result」のC列に、sheet1のB列(名前)の必要部分のみをコピーします。
4、「result」のNoを、1から連番にします。

1は
 Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
 ActiveSheet.Name = "RESULT"
で、よいでしょう。

しかし、2がわかりません。1つのsheet内での、重複比較は、本に載っていますが、別のシートの比較方法が不明なためです。

3は、難解で、全く、解らないです。

Sheet1
No.    名前    性別
B01    石川    女
B02    森田    男
A01    梅尾    女
A02    福田    男


Sheet2
番号    No.    住所    年齢    特徴
                
1    A03    アメリカ    19歳    数学が得意
2    A04    長野    19歳    数学が得意
3    A01    東京    19歳    国語が得意
4    A02    鹿児島    19歳    国語、英語、数学、運動が得意
                

ほしい結果(result)
番号    No.    住所    名前    年齢    特徴
                    
1    A01    東京    梅尾    19歳    国語が得意
2    A02    鹿児島    福田    19歳    国語、英語、数学、運動が得意

【75563】Re:マクロで、同じ番号行だけを残す方法
発言  Yuki  - 14/5/18(日) 8:42 -

引用なし
パスワード
   ▼ザ 焼鳥男 さん:
こんにちは、

>マクロ手順
>1、まずsheet1とsheet2がありsheet2を、新たに、新しいsheetにコピーして、タグ名を、「result」にします。
>2、sheet1のA列とsheet2のB列の番号を、比較して、同じ番号だけを残します。
>3、「result」のC列に、sheet1のB列(名前)の必要部分のみをコピーします。
>4、「result」のNoを、1から連番にします。
>
>1は
> Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
> ActiveSheet.Name = "RESULT"
>で、よいでしょう。
>
>しかし、2がわかりません。1つのsheet内での、重複比較は、本に載っていますが、別のシートの比較方法が不明なためです。
>
>3は、難解で、全く、解らないです。
>
>Sheet1
>No.    名前    性別
>B01    石川    女
>B02    森田    男
>A01    梅尾    女
>A02    福田    男
>
>
>Sheet2
>番号    No.    住所    年齢    特徴
>                
>1    A03    アメリカ    19歳    数学が得意
>2    A04    長野    19歳    数学が得意
>3    A01    東京    19歳    国語が得意
>4    A02    鹿児島    19歳    国語、英語、数学、運動が得意
>                
>
>ほしい結果(result)
>番号    No.    住所    名前    年齢    特徴
>                    
>1    A01    東京    梅尾    19歳    国語が得意
>2    A02    鹿児島    福田    19歳    国語、英語、数学、運動が得意

データは正しく書きましょう・上記の場合全部不一致ですよ。

Option Explicit

Sub TESTa()
  Dim Dic   As Object
  Dim v    As Variant
  Dim i    As Long
  Dim j    As Long
  Dim sht   As Worksheet
  Dim eRow  As Long
  
' result シートのチェック
  On Error Resume Next
  Set sht = Worksheets("result")
  If Err.Number = 0 Then
    sht.Cells.ClearContents   'シートがあったらクリア
  Else              '無かったら追加
    Set sht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    sht.Name = "result"     '名前を result
  End If
  On Error GoTo 0
' ******************* 此処まで **************

  With Worksheets("Sheet1")
    v = .Range("A1").CurrentRegion.Value
  End With
' Dictionary に登録
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(v)
    Dic(v(i, 1)) = Empty
  Next
  
  eRow = 1
  With Worksheets("Sheet2")
    .Cells(1, 1).Resize(, 5).Copy sht.Cells(eRow, 1)
    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
'      Dictionary の登録とあえば
      If Dic.Exists(.Cells(i, 2).Value) Then
'        行を追加してコピペ
        eRow = eRow + 1
        sht.Cells(eRow, 1).Value = eRow - 1
        .Cells(i, 2).Resize(, 4).Copy sht.Cells(eRow, 2)
      End If
    Next
  End With
End Sub

【75564】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/18(日) 10:13 -

引用なし
パスワード
   Yuki様、ご回答有難う御座います。
昨日から、困っておりましたが、非常に助かりました。
>データは正しく書きましょう・上記の場合全部不一致ですよ。
承知致しました。以後、注意したします。

申し訳御座いません。更に以下をご教示頂きましたら幸いです。
1、resultに、名前  梅尾  福田 の列の追加は可能でしょうか?
2、私は、超初心者で、以下の参考本を見ながら、そのまま使えるか?応用が出来ないか?を確認しながら、マクロを作ろうとしております。
しかし、今回の場合、本を見ても、そのまま使える例が無く、また応用も出来ませんでした。どうやれば、このようなコードが書けるようになるのでしょうか?もっと例題の多い本やネットのサイト等があるのでしょうか?
最初は、VBAも真似から入るはずだと考えるのですが、真似る材料を見つけることが出来ない状態です。
参考本
「すぐわかるExcel マクロ&VBAサンプル集」
「Excel VBA 逆引き辞典パーフェクト2013/2010/2007/2003対応」
「Excel VBAプログラミング ユーザーフォーム&コントロール

【75565】Re:マクロで、同じ番号行だけを残す方法
発言  Yuki  - 14/5/18(日) 11:30 -

引用なし
パスワード
   こんにちは。

質問はよく考えて追加しないように解答者にとっては2重になりますから。
ついでに性別も追加できるようにしておきました。
使う場合は性別無しの下の行をコメントにして
性別有りの下の行をコメントを外してください。

御自分の質問だけでなく他の質問者の内容もチェックして
自分だったらどう考えるかなとかしてみましょう。
実践的で勉強になると思います。
よそのサイトですが
//www.moug.net/faq/viewforum.php?f=2
も参考にしてみられては。

Option Explicit

Sub TESTa()
  Dim Dic   As Object
  Dim v    As Variant
  Dim i    As Long
  Dim j    As Long
  Dim sht   As Worksheet
  Dim eRow  As Long
  
' result シートのチェック
  On Error Resume Next
  Set sht = Worksheets("result")
  If Err.Number = 0 Then
    sht.Cells.ClearContents   'シートがあったらクリア
  Else              '無かったら追加
    Set sht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    sht.Name = "result"     '名前を result
  End If
  On Error GoTo 0
' ******************* 此処まで **************

  With Worksheets("Sheet1")
    v = .Range("A1").CurrentRegion.Value
  End With
' Dictionary に登録
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(v)
    Dic(v(i, 1)) = i
  Next

' 性別有り ***** この↓1行
'  sht.Cells(1, 1).Resize(, 7).Value = Array("番号", "No.", "名前", "性別", "住所", "年齢", "特徴")
' 性別無し ***** この↓1行
  sht.Cells(1, 1).Resize(, 6).Value = Array("番号", "No.", "名前", "住所", "年齢", "特徴")
  
  eRow = 1
  With Worksheets("Sheet2")
'    .Cells(1, 1).Resize(, 5).Copy sht.Cells(eRow, 1)
    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
'      Dictionary の登録とあえば
      If Dic.Exists(.Cells(i, 2).Value) Then
'        行を追加してコピペ
        eRow = eRow + 1
        sht.Cells(eRow, 1).Value = eRow - 1
        .Cells(i, 2).Resize(, 1).Copy sht.Cells(eRow, 2)
      '性別有り ***** この↓ 2行
'        Worksheets("Sheet1").Cells(Dic(.Cells(i, 2).Value), 2).Resize(, 2).Copy sht.Cells(eRow, 3)
'        .Cells(i, 3).Resize(, 3).Copy sht.Cells(eRow, 5)
      '性別無し ***** この↓ 2行
        Worksheets("Sheet1").Cells(Dic(.Cells(i, 2).Value), 2).Resize(, 1).Copy sht.Cells(eRow, 3)
        .Cells(i, 3).Resize(, 3).Copy sht.Cells(eRow, 4)
      End If
    Next
  End With
End Sub

【75566】Re:マクロで、同じ番号行だけを残す方法
発言  カエムワセト  - 14/5/18(日) 11:44 -

引用なし
パスワード
   >よそのサイトですが

焼き鳥男さんは、あちらのラーメンマン参上さんですが・・・。
あちらで回答者が用事で出かける、ということでこちらに移られたようです。
すこし待ったらsimpleさんから回答が付いたとは思うけど待てなかったので
しょう。

【75567】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/18(日) 15:22 -

引用なし
パスワード
   Yuki様
ご丁寧なご回答有難う御座います。

>質問はよく考えて追加しないように解答者にとっては2重になりますから。
>ついでに性別も追加できるようにしておきました。
申し訳御座いません。

>使う場合は性別無しの下の行をコメントにして
>性別有りの下の行をコメントを外してください。
有難う御座います。

>御自分の質問だけでなく他の質問者の内容もチェックして
>自分だったらどう考えるかなとかしてみましょう。
>実践的で勉強になると思います。
そのように致します。

>' Dictionary に登録
>  Set Dic = CreateObject("Scripting.Dictionary")
>  For i = 2 To UBound(v)
>    Dic(v(i, 1)) = i
>  Next
このようにデータを、一旦、登録するのですね。
ここで、質問させて頂きました例は、6列しかないのですが、使っていますデータは、開示できないのですが、20列ぐらいあり、そのExcel シートも、現在、見直し中であり、変更される可能性が高いです。
>sht.Cells(1, 1).Resize(, 6).Value = Array("番号", "No.", "名前", "住所", "年齢", "特徴")
従いまして、

Sub macro1()
 Dim LastRow As Long
 LastRow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row

'結果シートを準備
 Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
 ActiveSheet.Name = "RESULT"

'ファイル1から転記、不要な行を抹消
 Range("C1:C" & LastRow).Formula = "=VLOOKUP(A1,Sheet1!A:D,3,FALSE)"
 On Error Resume Next
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
 Range("C1:C" & LastRow).Value = Range("C1:C" & LastRow).Value
End Sub


一旦、sheet2を、resulにコピーして、VLOOKUPコマンドを使って処理できないかと考えています。
上のコードを実行しますと、下記の「マクロ実行結果」になってしまいます。
理想の結果を得るには、コードのどこを修正すれば、良いでしょうか?

Shieet1
No.    名称    相対的強さ    研究者
            
F03    精神力    ∞    アドラー博士
F04    筋力    10^38    フランケンシュタイン博士
A01    重力    10^0    アインシュタイン博士
A02    電磁気力    10^38    マクスウエル博士

Sheet2 これが実際には20行あります。
ナンバー    ネーム    ボゾン    ボゾン質量    関連力    方程式    到達距離    関係者    備考
A03    弱い力    W,Zボゾン    有り    放射能、核融合    ワインバーグ・サラム理論    有限    フェルミ、グラショー     
A04    強い力    グルーオン    有り    原子力    標準理論    有限    グロス、湯川     
A01    重力    重力子    無し    遠心力、重力    アインシュタイン方程式    無限    ニュートン、ヒルベルト、ワイル、グロスマン     
A02    電磁気力    光子    無し    摩擦、モータ    マクスウエル方程式    無限    ディラック、ファラデー


マクロ実行結果
A01    重力    10^0    無し    遠心力、重力    アインシュタイン方程式    無限    ニュートン、ヒルベルト、ワイル、グロスマン     
A02    電磁気力    10^38    無し    摩擦、モータ    マクスウエル方程式    無限    ディラック、ファラデー     


理想
ナンバー    ネーム    相対的強さ    ボゾン質量    関連力    方程式    到達距離    関係者    備考
A01    重力    10^0    無し    遠心力、重力    アインシュタイン方程式    無限    ニュートン、ヒルベルト、ワイル、グロスマン     
A02    電磁気力    10^38    無し    摩擦、モータ    マクスウエル方程式    無限    ディラック、ファラデー     


いろいろと、自分で考えて、試していました。お返事が遅くなって、すいません。


>すこし待ったらsimpleさんから回答が付いたとは思うけど待てなかったので
しょう。

初心者で、要領がよく解りませんでした。お許し願います。

【75568】Re:マクロで、同じ番号行だけを残す方法
発言  ザ 焼鳥男  - 14/5/18(日) 15:36 -

引用なし
パスワード
   すいません。質問がぐちゃぐちゃになって見づらくなりました。
整理しますと
以下のコードで

Sub macro1()
 Dim LastRow As Long
 LastRow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row

'結果シートを準備
 Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
 ActiveSheet.Name = "RESULT"

'ファイル1から転記、不要な行を抹消
 Range("C1:C" & LastRow).Formula = "=VLOOKUP(A1,Sheet1!A:D,3,FALSE)"
 On Error Resume Next
Range("C1:C" & LastRow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
Range("C1:C" & LastRow).Value = Range("C1:C" & LastRow).Value
End Sub
Sheet1
No.    名称    相対的強さ    研究者
            
F03    精神力    ∞    アドラー博士
F04    筋力    10^38    フランケンシュタイン博士
A01    重力    10^0    アインシュタイン博士
A02    電磁気力    10^38    マクスウエル博士
Sheet2
ナンバー    ネーム    ボゾン    ボゾン質量    方程式
A03    弱い力    W,Zボゾン    有り    ワインバーグ・サラム理論
A04    強い力    グルーオン    有り    標準理論
A01    重力    重力子    無し    アインシュタイン方程式
A02    電磁気力    光子    無し    マクスウエル方程式
                

を、実行すると
A01    重力    10^0    無し    アインシュタイン方程式
A02    電磁気力    10^38    無し    マクスウエル方程式

となります。

下記を表示させるには、どこを修正すれば良いでしょうか?
ナンバー    ネーム    相対的強さ    ボゾン質量    方程式
A01    重力    10^0    無し    アインシュタイン方程式
A02    電磁気力    10^38    無し    マクスウエル方程式

【75569】Re:マクロで、同じ番号行だけを残す方法
発言  Yuki  - 14/5/18(日) 16:55 -

引用なし
パスワード
   ▼ザ 焼鳥男 さん:
前回の応用で出来ます。

Option Explicit

Sub TESTa()
  Dim Dic   As Object
  Dim v    As Variant
  Dim i    As Long
  Dim j    As Long
  Dim sht   As Worksheet
  Dim eRow  As Long
  
' result シートのチェック
  On Error Resume Next
  Set sht = Worksheets("result")
  If Err.Number = 0 Then
    sht.Cells.ClearContents   'シートがあったらクリア
  Else              '無かったら追加
    Set sht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    sht.Name = "result"     '名前を result
  End If
  On Error GoTo 0
' ******************* 此処まで **************

  With Worksheets("Sheet11")
    v = .Range("A1").CurrentRegion.Value
  End With
' Dictionary に登録
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(v)
    Dic(v(i, 1)) = i
  Next

  sht.Cells(1, 1).Resize(, 9).Value = Array( _
          "ナンバー", "ネーム", "相対的強さ", "ボゾン質量", _
          "関連力", "方程式", "到達距離", "関係者", "備考")
  eRow = 1
  With Worksheets("Sheet12")
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
'      Dictionary の登録とあえば
      If Dic.Exists(.Cells(i, 1).Value) Then
'        行番号を追加してコピペ
        eRow = eRow + 1
        .Cells(i, 1).Resize(, 2).Copy sht.Cells(eRow, 1)
        Worksheets("Sheet11").Cells(Dic(.Cells(i, 1).Value), 3).Copy sht.Cells(eRow, 3)
        .Cells(i, 4).Resize(, 6).Copy sht.Cells(eRow, 4)
      End If
    Next
  End With
End Sub

【75571】Re:マクロで、同じ番号行だけを残す方法
お礼  ザ 焼鳥男  - 14/5/18(日) 20:33 -

引用なし
パスワード
   yuki様

いつもお世話になっております。

有難う御座いました。

教えて頂きましたコードを大切に使わせて頂きます。

VBAは、何でも出来ますが、自分が使うパターンは決まっていますので、

数パターンを、覚えるようにします。

その前に、コマンドの意味を理解して、応用が出来るようにします。

今後とも、よろしくご指導願います。

【75572】Re:マクロで、同じ番号行だけを残す方法
発言  γ  - 14/5/18(日) 22:25 -

引用なし
パスワード
   興味深いので、作成してみました。
Yukiさんのは、必要なデータのみコピーする方式ですが、
質問者さんは Sheet2をそのままコピーして、あとから削除する方式。
私もYukiさん方式を採用するだろうが、一応、質問者さん方式で作成しました。

また、質問の最初にあるように結合セルをあえて対象にしています。

■問題の説明(改めて)

<<Sheet1>>
  A  B   C
1 No. 名前  性別
2 A01 梅尾  女
3 A02 福田  男
4 B01 石川  女
5 B02 森田  男

<<Sheet2>>
  A  B   C    D   E
1 
2 タイトル
3 番号 No. 住所 年齢 特徴
4                  
5 1  A01  東京  19歳 国語が得意
20 2  A02  鹿児島 19歳 国語、国語、英語、数学、運動が得意
35 3  A03  米国  19歳 数学が得意
(なお、3〜4行目はセル結合されている。
5〜19,20〜34,35〜49行のA〜D列は、セル結合されています。

------------------------------
やりたいことは、
・Sheet2をコピーした Resultシートを作成し、
・以下のように、
 B列とC列の間に、(No.に対応してSheet1で得られる)名前を挿入することです。

<<Result>>
  A  B   C    D    E   F
1 
2 タイトル
3 番号 No. 名前  住所  年齢 特徴
4                  
5 1  A01  梅尾  東京  19歳 国語が得意
20 2  A02  福田  鹿児島 19歳 国語、国語、英語、数学、運動が得意

(なお、セル結合はSheet2と同じ。1データが15行に渡って結合されている。)

-------------
手順:

1. Sheet2をコピーして Resultシートを作成
2. ResultシートのB列をC列に挿入コピー(それより右の列は右側に移動)
3. Resultシートについて以下の作業を行う。
  (1)B列のデータあり最終行を求める。
  (2)その行から、5行目までについて、15行おきに下から、以下の作業を繰り返す。
  (2)そのセルのNo.がSheet1にあれば、それに対応する「名前」をC列に上書き。
  (3)そのセルのNo.がSheet1になければ、そのセルの行から始まる15行を削除する。

-------------
参考コード(あえてDictionaryを使わない方式)

Sub test2()
  Dim resWS As Worksheet
  Dim k As Long
  Dim lastRow As Long
  Dim s As String
  Dim v
  
  Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
  Set resWS = ActiveSheet
  resWS.Name = "RESULT"

  With resWS
    .Columns("B").Copy
    .Columns("C").Insert Shift:=xlToRight
    .Range("C3").Value = "名前"
    lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    
    For k = lastRow To 5 Step -15
      s = .Cells(k, 2).Value
      
      v = Application.VLookup(s, Worksheets("Sheet1").Range("A:C"), _
                  2, False)
      If Not IsError(v) Then
        .Cells(k, 3).Value = v
      Else
        .Cells(k, 1).Resize(15, 1).EntireRow.Delete
      End If
    Next
  End With
End Sub

なお、セル結合は、ソートしたくても簡単にはできないし、
データ部分をセル結合するのは避けた方が得だと思う。

-------------
それから、
> しかし、今回の場合、本を見ても、そのまま使える例が無く、また応用も出来ませんでした。
> どうやれば、このようなコードが書けるようになるのでしょうか?
> もっと例題の多い本やネットのサイト等があるのでしょうか?
についてひとこと。

そのまま写せば済むようなら誰も苦労しません。現実はそれなりに複雑です。
そう難しくもないだろうが、舐めてかかってできるものでもない。
ネットのどこかに答えが書いてあるわけでもありません。
面倒でも、ひとつひとつのケースを深掘りして経験を蓄積していくしかありません。

他人とのやりとりも一字一句を正確に記述する、
そのような、ある意味で辛気くさいことを実行する覚悟がないと、簡単には行きません。
しかし、掛けた労力は必ずきちんと返って来るはずです。

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