Excel VBA質問箱 IV

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

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


43130 / 76735 ←次へ | 前へ→

【38661】Re:セルの下にまとまって入れ込む
回答  Statis  - 06/6/8(木) 9:27 -

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

お試しを。
尚、1行目は項目行であること。

Sub Test_1()
Dim Ws As Worksheet, Da As Variant, R As Range, C As Range
Dim Myma As Variant, Myma1 As Variant, Co As Long, i As Long


Set Ws = Worksheets("総合")
With Worksheets("A")
   With .Range("A1", .Range("A65536").End(xlUp))
     Da = .Value
     .AdvancedFilter xlFilterCopy, , Worksheets("A").Range("IV1"), True
   End With
   Set R = .Range("IV2", .Range("IV65536").End(xlUp))
   For Each C In R
     Myma = Application.Match(C.Value, .Columns(1), 0)
     If Not IsError(Myma) Then
      Myma1 = Application.Match(.Cells(Myma, 2).Value, Ws.Columns(3), 0)
      If Not IsError(Myma1) Then
        Co = 0
        For i = Myma To UBound(Da)
          If Da(i, 1) <> C.Value Then
           Exit For
          End If
          Co = Co + 1
        Next i
        .Cells(Myma + 1, 2).Resize(Co-1).Copy Ws.Cells(Myma1 + 1, 3)
      End If
     End If
   Next C
   .Columns(256).Clear
End With
Set R = Nothing: Set Ws = Nothing

End Sub

0 hits

【38626】セルの下にまとまって入れ込む ごまみそ 06/6/7(水) 16:12 質問
【38628】Re:セルの下にまとまって入れ込む Statis 06/6/7(水) 16:24 発言
【38630】Re:セルの下にまとまって入れ込む ごまみそ 06/6/7(水) 16:34 発言
【38632】Re:セルの下にまとまって入れ込む Kein 06/6/7(水) 16:38 回答
【38633】Re:セルの下にまとまって入れ込む Kein 06/6/7(水) 16:41 発言
【38658】Re:セルの下にまとまって入れ込む ごまみそ 06/6/8(木) 8:19 質問
【38648】Re:セルの下にまとまって入れ込む ごまみそ 06/6/7(水) 18:44 質問
【38657】Re:セルの下にまとまって入れ込む ごまみそ 06/6/8(木) 8:13 質問
【38661】Re:セルの下にまとまって入れ込む Statis 06/6/8(木) 9:27 回答
【38688】Re:セルの下にまとまって入れ込む Kein 06/6/8(木) 15:30 回答
【38757】Re:セルの下にまとまって入れ込む ごまみそ 06/6/9(金) 15:42 質問
【38778】Re:セルの下にまとまって入れ込む Kein 06/6/9(金) 21:48 回答
【38842】Re:セルの下にまとまって入れ込む ごまみそ 06/6/12(月) 9:34 質問
【38844】Re:セルの下にまとまって入れ込む ごまみそ 06/6/12(月) 11:16 発言
【38847】Re:セルの下にまとまって入れ込む Kein 06/6/12(月) 14:20 回答
【38876】Re:セルの下にまとまって入れ込む ごまみそ 06/6/13(火) 12:42 お礼

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