Excel VBA質問箱 IV

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

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


5075 / 13644 ツリー ←次へ | 前へ→

【52646】シート列の照合 素人 07/11/23(金) 16:26 質問[未読]
【52717】Re:シート列の照合 りん 07/11/28(水) 11:28 回答[未読]
【52736】Re:シート列の照合 素人 07/11/29(木) 17:17 お礼[未読]

【52646】シート列の照合
質問  素人  - 07/11/23(金) 16:26 -

引用なし
パスワード
   2つのシートのそれぞれA列の文字を照合して同じ場合は、片方のシート1のI列からデータのある最終列までCOPYしてもうひとつのシート2に貼り付けしたいです
同じ文字がない場合は、シート2のA列の最終行にシート1のその値を貼り付けたいです誰かわかる方アドバイスお願いいたします。
*シート2のA列は必ず空白のところが5行あります。

(シート1)
A列       I列・・・・・・
文字1
文字2*空白はない
文字3
文字4
(シート2)    I列・・・・・
A列       
文字2      (シ-ト1)文字2を貼り付け(文字2の文字があるの最終列まで)

(空白5)

文字1

(空白5)


文字4

(空白5)

【52717】Re:シート列の照合
回答  りん E-MAIL  - 07/11/28(水) 11:28 -

引用なし
パスワード
   素人 さん、こんにちわ。

>2つのシートのそれぞれA列の文字を照合して同じ場合は、片方のシート1のI列からデータのある最終列までCOPYしてもうひとつのシート2に貼り付けしたいです
>同じ文字がない場合は、シート2のA列の最終行にシート1のその値を貼り付けたいです誰かわかる方アドバイスお願いいたします。

ワークシート関数を使ってチェックをかけてます。
Sub test()
  Dim ws(1 To 2) As Worksheet
  Dim Rmax As Long, Cmax As Long, RR As Long, Rpos As Long
  Set ws(1) = ThisWorkbook.Worksheets("Sheet1")
  Set ws(2) = ThisWorkbook.Worksheets("Sheet2")
  '
  With ws(1)
   With .UsedRange
     Rmax = .Cells(.Count).Row
     Cmax = .Cells(.Count).Column
   End With
   For RR = 1 To Rmax
     '空白以外を処理
     If .Cells(RR, 1).Value <> "" Then
      'ワークシート関数を活用
      If Application.WorksheetFunction. _
         CountIf(ws(2).Columns(1), .Cells(RR, 1).Value) = 0 Then
        'なかったら下にコピペ(5行あけなくていいのかな?)
        With ws(2)
         Rpos = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
         ws(1).Rows(RR).Copy Destination:=.Cells(Rpos, 1) '行単位で貼り付け
        End With
      Else
        Rpos = Application.WorksheetFunction. _
         Match(.Cells(RR, 1).Value, ws(2).Columns(1), 0)
        'コピペする
        .Range(.Cells(RR, 9), .Cells(RR, Cmax)).Copy Destination:=ws(2).Cells(Rpos, 9)
      End If
     End If
   Next
  End With
  '
  Erase ws
End Sub

こんな感じです。
書式が行って欲しくない時は、PasteSpecialメソッドを使用して貼りつけるようにします。

【52736】Re:シート列の照合
お礼  素人  - 07/11/29(木) 17:17 -

引用なし
パスワード
   ▼りん さん:
>素人 さん、こんにちわ。
>
>>2つのシートのそれぞれA列の文字を照合して同じ場合は、片方のシート1のI列からデータのある最終列までCOPYしてもうひとつのシート2に貼り付けしたいです
>>同じ文字がない場合は、シート2のA列の最終行にシート1のその値を貼り付けたいです誰かわかる方アドバイスお願いいたします。
>
>ワークシート関数を使ってチェックをかけてます。
>Sub test()
>  Dim ws(1 To 2) As Worksheet
>  Dim Rmax As Long, Cmax As Long, RR As Long, Rpos As Long
>  Set ws(1) = ThisWorkbook.Worksheets("Sheet1")
>  Set ws(2) = ThisWorkbook.Worksheets("Sheet2")
>  '
>  With ws(1)
>   With .UsedRange
>     Rmax = .Cells(.Count).Row
>     Cmax = .Cells(.Count).Column
>   End With
>   For RR = 1 To Rmax
>     '空白以外を処理
>     If .Cells(RR, 1).Value <> "" Then
>      'ワークシート関数を活用
>      If Application.WorksheetFunction. _
>         CountIf(ws(2).Columns(1), .Cells(RR, 1).Value) = 0 Then
>        'なかったら下にコピペ(5行あけなくていいのかな?)
>        With ws(2)
>         Rpos = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
>         ws(1).Rows(RR).Copy Destination:=.Cells(Rpos, 1) '行単位で貼り付け
>        End With
>      Else
>        Rpos = Application.WorksheetFunction. _
>         Match(.Cells(RR, 1).Value, ws(2).Columns(1), 0)
>        'コピペする
>        .Range(.Cells(RR, 9), .Cells(RR, Cmax)).Copy Destination:=ws(2).Cells(Rpos, 9)
>      End If
>     End If
>   Next
>  End With
>  '
>  Erase ws
>End Sub
>
>こんな感じです。
>書式が行って欲しくない時は、PasteSpecialメソッドを使用して貼りつけるようにします。
早速返信いただきありがとうございます。
うまくいきましたありがとうございました。
また教えていただくことが多々あると思いますがよろしくお願いいたします。
素人

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