Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
条件一致 振り分け
投稿日時: 20/08/14 12:57:19
投稿者: monamona

はじめまして
会社で事務をやっています。入社して半年経っていませんが、普段使用する一覧をVBAで処理できないかと
色々さがしてこちらにたどり着きました。VBAも最近始めたばかりでハードルが高いとは思いますが、
日々の仕事を少しで効率よくでいないかと思い投稿させて頂きます。
(素人でわかりにくい部分や的外れな内容がありましたらすいません)
・やりたい事(Sheet1 a b というシートがある状態です)
Sheet1にあるA列のデータをデータの内容毎に別シートへ転記したいです。(〇シート名です)
〇Sheet1              
    A列 B列 C列 D列   Sheet1のA列にaがあった場合、シートaの8行目以降に
1行  a 1    10   Sheet1のB列の値をシートaのA列に Sheet1のD列の値をシートaのB列に
2行  b 1     10   繰り返し転記したいです。
3行  a 2     20
下記のように記載してみましたが全く思ったものと違いました。
何とか完成させたいと思いますのでお力をお貸しください。
Sub wS()
 Set ws1 = Worksheets("Sheet1")
 Set ws2 = Worksheets("aaaa"),("bbb")
  j = 8
 For i = 6 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
  f = ws1.Cells(i, 1).Value
 If f = "aaaa" Then
  ws2.Cells(j, 1) = f
 End If
  j = j + 1
 Next i
End Sub
 

回答
投稿日時: 20/08/14 14:31:32
投稿者: WinArrow
投稿者のウェブサイトに移動

よくわからないところがあるので、質問
 
> Set ws2 = Worksheets("aaaa"),("bbb")
このコードは、何を目的としているんでしょうか?
 
> If f = "aaaa" Then
 
A列セルが"a"の時
という説明があるので
If f ="a"
ではないですか?
 
>  ws2.Cells(j, 1) = f
ここで代入しているのは、f  ・・・つまりA列セルの値ですよね?
B列セルの値でしたら
ws2.Cells(j, 1) = ws1.Cells(i, 2).Value
ではないでしょうか?
 
 
もっとわかりやすく記述するにあ、
ws2.Cells(j, "A") = ws1.Cells(i, "B").Value
こんな方法もあるので、覚えておくとよいでしょう。
 

回答
投稿日時: 20/08/14 17:11:33
投稿者: simple

設例はこうですね。コードの書式にすると、桁ズレが起きません。

〇Sheet1                                 
        A列  B列  C列  D列      Sheet1のA列にaがあった場合、シートaの8行目以降に
1行    a    1          10      Sheet1のB列の値をシートaのA列に  Sheet1のD列の値をシートaのB列に
2行    b    1          10      繰り返し転記したいです。
3行    a    2          20

また、コードもきちんとインデントをつけると、
論理がわかりやすくなると思います。(内容はそのままです)
例えば、j = j + 1 が実行されるのはどういう時か、といったことが
分かり易くなると思うのです。
 
Sub wS()
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("aaaa")
    j = 8
    For i = 6 To ws1.Cells(ws1.Rows.count, 1).End(xlUp).Row
        f = ws1.Cells(i, 1).Value
        If f = "aaaa" Then
            ws2.Cells(j, 1) = f
        End If
        j = j + 1
    Next i
End Sub

投稿日時: 20/08/14 18:20:42
投稿者: monamona

ごめんなさい。
記載したコードですが、WinArrow様の私的通り”aaa”ではなく"a"です。
わかりやすくするつもりで文章を記載したつもりがコードのほうは書き換え忘れていました。
混乱させてすいません。
また、コードについても見づらくてすいません。 
 
@ ・"Sheet1"のA列6行目以降に"a"があった場合
        → "Sheet1"のB列の値を、"シートa"の8行目以降にコピー
A ・"Sheet1"のA列6行目以降に"b"があった場合
        → "Sheet1"のB列の値を、"シートb"の8行目以降にコピー
以上がやりたいことです。
先に記載したコードですとテスト的に"シートa"を対象にしたとはいえ、思った位置に転記できません
でした。 ネットで調べたりしてみましたが、転記先のコントロールが出来ずに
止まってしまっています。
 

回答
投稿日時: 20/08/14 18:39:01
投稿者: simple

今は"a"であろうがなかろうが
書き込み先の行であるjを進めて(j=j+1)
しまっていますよね。
"a"であって転記した後にだけjを進めれば良いのでは?
ということを言いたかったのですが・・。
伝わりませんでしたか。

回答
投稿日時: 20/08/14 19:44:13
投稿者: WinArrow
投稿者のウェブサイトに移動

条件によって、転記先シートが異なる場合、
各々のシートオブジェクト変数を用意した方がよい・・・べきです。
 

回答
投稿日時: 20/08/14 19:50:25
投稿者: WinArrow
投稿者のウェブサイトに移動

>j = j + 1
 
を使用しない参考コード
 

Sub wS()
Dim Ws1 As Worksheet
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim i As Long, j As Long

    Set Ws1 = Worksheets("Sheet1")
    Set wsA = Worksheets("aaaa")
    Set wsB = Worksheets("bbbb")
    
    With Ws1
        For i = 6 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A").Value = "a" Then
                j = WorksheetFunction.Max(7, wsA.Cells(wsA.Rows.Count).End(xlUp).Row + 1)
                wsA.Cells(j, "A").Value = .Cells(i, "B").Value
            ElseIf .Cells(i, "A").Value = "b" Then
                j = WorksheetFunction.Max(7, wsB.Cells(wsB.Rows.Count).End(xlUp).Row + 1)
                wsB.Cells(j, "A").Value = .Cells(i, "B").Value
            End If
        Next
    End With
 End Sub

回答
投稿日時: 20/08/14 20:42:39
投稿者: simple

質問者さんのコードにできるだけ沿ったものを提示してみます。
 

Sub test()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ary As Variant
    Dim k   As Long
    Dim i   As Long
    Dim j   As Long
    Dim s   As String
    Dim f   As String
    
    Set ws1 = Worksheets("Sheet1")

    ary = Array("a", "b")
    For k = 0 To 1
        s = ary(k)
        Set ws2 = Worksheets(s)
        j = 8
        For i = 6 To ws1.Cells(ws1.Rows.count, 1).End(xlUp).Row
            f = ws1.Cells(i, "A").Value
            If f = s Then
                ws2.Cells(j, "A").Value = ws1.Cells(i, "B").Value
                ws2.Cells(j, "B").Value = ws1.Cells(i, "D").Value
                j = j + 1    '一致したときだけ進めます。
            End If
        Next i
    Next
End Sub

回答
投稿日時: 20/08/15 10:46:12
投稿者: simple

このほか、オートフィルタで絞り込んで、コピーペイストする方法もあると思います。

投稿日時: 20/08/16 15:45:35
投稿者: monamona

Winarrow様、simple様 丁寧にアドバイス・ご教授頂き有難うございます。
ほぼ完成に違い状態になりました。初心者の的外れな質問にもご対応頂き勉強になりました。
頂いた内容を元に完成まで色々試行してみます。
有難うございました。

投稿日時: 20/08/16 21:30:55
投稿者: monamona

Winarrow様、simple様
夕方から色々試し、解決できました。
会社で使用しているデータ(200ファイル)を集約して一つのファイルにした後で、項目ごとに振り分ける
必要があったのですが、集約したファイル自体もシートが20枚ほどあり非常に手間取りました。
お二人のおかげで振り分けと集計作業が解決しました。
本当に有難うございました。