Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
文字列で判断し別シートの該当の列に転記したい
投稿日時: 19/11/12 15:27:37
投稿者: miiiiiim

データの転記を自動化したく、質問させてください。
 
現在、送られてくるExcelファイル(A)の内容を管理簿へ転記する作業を行っております。
管理簿として利用しているExcelファイル(B)の1枚目のシートのA列がNo(通番)・B列が受付日・C列に受付No・D列に転記の作業をした担当者名・E〜G列に種類別に個数を記載するようになっております。
Excel(A)には、管理簿のExcel(B)に転記する以外の情報も記載されている状況です。
なので、現在は必要なデータ部分だけ、全て手作業でデータ転記をしております。
 
管理簿のExcel(B)に2枚目のシートを追加し、そこに受付Noを貼り付けてマクロを実行することで、1枚目のシートの最終行に受付Noと作業日が追加されるようにはできました。
E〜G列の種類別に個数を記載する部分について、どのようにコードを書いていいか分からない状態です。
 
管理簿のExcel(B)のE〜G列のヘッダーが
E列にりんご・F列にみかん・G列にスイカとなっており
Excel(A)には○○りんご 2
      ○○みかん 3
      ○○スイカ 10
のように、プラスで何か文字が加えられた状態で記載されています。
(「○○りんご」とその次の個数は別セルに記載されています。)
 
このExcel(A)の「○○りんご」の列と個数の列を
管理簿のExcel(B)の追加したシートへ貼り付け
「りんご」・「みかん」・「スイカ」の文字列で判断し、1枚目のシートの該当のセルに
値を記載するということを行いたいと思っております。
 
このようなことができるのでしょうか?
文字列で判断すればよいのかなと思い、If文で書いてみたのですが
転記する列が上手く指定することができませんでした。
 
分かりにくい文面で申し訳ございませんが、お力添えいただければ幸いです。
よろしくお願いいたします。

回答
投稿日時: 19/11/12 16:19:13
投稿者: WinArrow
投稿者のウェブサイトに移動

確かにわかりにくい文面です。
 
どこで行き詰っているのでしょう?
 
「りんご」という文字列から、「○○りんご」の列が取得できればよいのでしょうか?
 
参考コード:列を取得する
 
Dim 項目名 As String
    項目名 = "りんご"
    Debug.Print WorksheetFunction.Match("*" & 項目名, Sheets(1).Rows(1), 0)

回答
投稿日時: 19/11/16 00:29:31
投稿者: コレ

 横から失礼します。
 
 ファイル構成等不足部分があるため私なりの解釈で下記のコードを作りました。
ざっくりとしたものなので、手を加える必要はありますが参考にしてもらえれば幸いです。
 
 シート1のA列に品名、B列に個数とします。
また、1行目は見出しとします。
マクロを実行すると振り分けした結果をシート2に表示するようにしました。
ただ、基本的な条件判断と転記するもののため参考までに。
 

Sub test()
    Dim WS As Worksheet
    Dim PastWS As Worksheet
    Dim i As Integer, n As Integer
    Dim myFil() As Variant
    
    myFil = Array("リンゴ", "みかん", "スイカ")
    
    Set WS = ThisWorkbook.Worksheets(1)
    Set PastWS = ThisWorkbook.Worksheets(2)
    
    With WS.Range("A1").CurrentRegion
        For i = 1 To .Rows.Count - 1
            For n = 0 To UBound(myFil)
                If WS.Cells(i + 1, 1).Value Like "*" & myFil(n) Then
                    WS.Cells(i + 1, 1).Resize(, 2).Copy PastWS.Cells(PastWS.Cells.Rows.Count, ((n) * 3) + 1).End(xlUp).Offset(1)
                    Exit For
                End If
            Next n
        Next i
    End With
    
  set ws = nothing
    set PastWS = nothing
    Erase myFil
    
End Sub

トピックに返信