Excel VBA質問箱 IV

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

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


6766 / 76734 ←次へ | 前へ→

【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

16 hits

【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 発言

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