[[20220629223744]] 『条件が一致したら別ブックへ転記処理』(ひろし) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『条件が一致したら別ブックへ転記処理』(ひろし)

マクロ初心者です。理解できていないところが多いですがお力添えいただけますと幸いです。

2つのブックがあり、番号が一致したら別ブックの該当セルにデータを転記する処理を行いたいです。

(やりたいこと詳細↓)
https://d.kuku.lu/ff4dd4743

全然書けていませんが、コード貼り付けます。

 '労務費シートに実績を転記
 Sub sample()

    '転記元
    Dim wbYosan As Workbook
    Dim wsYosan As Worksheet
    Set wsYosan = Worksheets("予算管理シート")

    '転記先を設定
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\ サンプル労務シート"
    Dim wbRoumu As Workbook
    Set wbRoumu = Workbooks.Open(FileName)
    Dim wsRoumu As Worksheet 'Q.労務費(△△)、労務費(□□)のどちらかに枝分かれする形にしたい

    '変数
    Dim i As Integer
    Dim pjNoY As Integer  '予算シートの業務番号
    Dim pjNoR As Integer '労務シートの業務番号
    Dim n As Variant
    Dim j As Integer
    Dim jj As Integer
    Dim k As Integer
    Dim Month As Integer ' 入力月
    Dim Num As Integer ' 実績月の列

    '転記処理
      Month = 5 '  5 月

      Num = Month - 4 + 8
      If Num <= 5 Then

          Num = Num + 12

      End If

    '予算管理表のD列に"100以上"がセットされいてる行を見つけて業務を特定する
      For i = 43 To 1000

            '着目行の値
            n = wsYosan.Cells(i, 4).Value

            If n > 100 Then

                '業務番号取得
                pjNoY = wsYosan.Cells(i, 5).Value
                pjNoR = wsRoumu.Cells(iR, 2).Value 'Q .別シートの行数を変数で指定するとき

                '予算管理シートから 労務シートに実績をコピー

                If pjNoY = pjNoR Then
                    j = 8 'H列から
                    jj = 19 'S列まで

                    For k = j To jj
                        wsRoumu.Cells(iR, Num - 1).Value = wsYosan.Cells(n + 3, k).Value 'Q . 労務シートの61 〜 82行の該当月にコピー
                    Next k

                    Exit For
                End If

            ElseIf n = "End" Then

                Application.StatusBar = False

                'ループ終了
                Exit For

            End If

        Next i

    Application.DisplayAlerts = False

    'ブックを保存
    wbYosan.Save

    'ブックを閉じる
    wbYosan.Close

    Application.DisplayAlerts = True

 End Sub

Option Explicit

'予算管理シートに見込み(実績月より後〜翌3月まで)をコピー
Sub test()

  '転記元
    Dim wbRoumu As Workbook

  '転記先を設定
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\ サンプル労務シート"
    Dim wbYosan As Workbook
    Set wbYosan = Workbooks.Open(FileName)
    Dim wsYosan As Worksheet
    Set wsYosan = Worksheets("予算管理シート")

  '変数
    Dim i As Integer
    Dim pjNoY As Integer  '予算シートの業務番号
    Dim pjNoR As Integer '労務シートの業務番号
    Dim n As Variant
    Dim Month As Integer   '入力月()
    Dim Num As Integer ' 実績月の列
    Dim rMonth As Integer  '読み込み始める列番号

    Month = 5 '  5 月

    Num = Month - 4 + 8
    If Num <= 5 Then

        Num = Num + 12

    End If

    rMonth = Num - 1 + 1 'ブック・シート間のずれで-1、翌月で+1 '5月=  労務H列 予算I列

    '業務番号取得
        pjNoY = wsYosan.Cells(iY, 5).Value 'Q .別シートの行数を変数で指定するとき
        pjNoR = wsRoumu.Cells(i, 2).Value

      For i = 33 To 54 '労務シート33〜54 行までの実績月翌月〜3月までをコピー

        If pjNoY = pjNoR Then

        '
        '
        '

        End If

      Next

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows10 >


画像も見てみたけど、ピンと来てないので何点か。(複雑っぽいので聞くだけになるかもですが)
 ======================================================

■1
↓はどのような狙いがあるのですか?

 Month = 5 '  5 月
 Num = Month - 4 + 8
 If Num <= 5 Then
     Num = Num + 12
 End If
 rMonth = Num - 1 + 1

対象年月がわかれば、G列(2022年4月)から数えて何列目か計算すればよいだけでは?
さらに、Match関数や、Findメソッドなんかでも【列】は特定できるのでは?

■2
「Dim wbYosan As Workbook」の宣言はあれども、取得してないからNothingのままですよね。
SaveもCloseもできないですよ。

同時に↓は

 Set wsYosan = Worksheets("予算管理シート")
 Set wsYosan = ActiveWorkbook.Worksheets("予算管理シート")

↑のように解釈されるんじゃないでしょうか?それでいいんですか?

■3
↓の意味が分かりません
>'Q.労務費(△△)、労務費(□□)のどちらかに枝分かれする形にしたい
シートを特定する情報がどこかにあるのではありませんか?

 例えばG5セルや、G17セルの内容から"業務〜"を除いたものが条件になるとか・・・

■4
↓の意味が分かりません。
>'予算管理表のD列に"100以上"がセットされいてる行を見つけて業務を特定する
画像を見る限りD列には何もなさそうですが・・・

むしろ、E5、E17、E29・・・と12行おきに業務番号と呼称している【文字列】が入っているように見えます
それを踏まえると↓は問題がないのでしょうか?

 Dim pjNoY As Integer
 pjNoY = wsYosan.Cells(i, 5).Valu

■5
↓の狙いはなんですか?

 pjNoR = wsRoumu.Cells(iR, 2).Value
 wsRoumu.Cells(iR, Num - 1).Value = 〜〜

「iR」の宣言がないので、Valiant型の初期値であるemptyになっていると思いますが、そんな行は無いから該当するセルが無いって怒られると思いますよ。

■6
↓の狙いはなんですか?

 j = 8 'H列から
 jj = 19 'S列まで
 For k = j To jj

↓と同じことですよね。一旦変数に格納することで、かえって分かりづらくなりませんか?

 For k = 8 To 19 'H〜S列まで

■7
↓の狙いはなんですか?

 Application.StatusBar = False

ステータスバーをいじってもないのに元に戻すんですか?

 ======================================================

とりあえず、ぱっと目についてよくわからない部分だけ。

(もこな2) 2022/06/30(木) 00:43


■3の補足
「■2」と同じですが、結局wsRoumuになにも格納してないからNothingのままです。
よって、■5を対象しても↓は実行時エラーになりますよ。
 pjNoR = wsRoumu.Cells(iR, 2).Value

(もこな2 ) 2022/06/30(木) 09:15


すみません、誤字です。
「対象」でなく、「対処」でした。

(もこな2 ) 2022/06/30(木) 09:19


かなりテキトーなので変な動きをしたらごめんなさい。
△△と□□の分岐方法などのブラックボックスは開けてくれるとうれしいです。

 '労務費シートに実績を転記
 Sub sample()

    '転記元
    Dim wbYosan As Workbook
    Dim wsYosan As Worksheet
    Set wsYosan = Worksheets("予算管理シート")

    '転記先を設定
    Dim wbRoumu As Workbook
    Dim wsRoumu As Worksheet 'Q.労務費(△△)、労務費(□□)のどちらかに枝分かれする形にしたい
    Dim FileName As String

    FileName = ThisWorkbook.Path & "\ サンプル労務シート"
    Set wbRoumu = Workbooks.Open(FileName)
    If True Then             'wsRoumuの枝分かれ用条件式
        Set wsRoumu = wbRoumu.Worksheets("労務費(△△)")
    Else
        Set wsRoumu = wbRoumu.Worksheets("労務費(□□)")
    End If

    '変数
    Dim n As Variant
    Dim pjNoY As Integer '予算シートの業務番号
    Dim pjNoR As Integer '労務シートの業務番号
    Dim Month As Integer ' 入力月
    Dim Num   As Integer ' 実績月の列

    Dim j  As Integer
    Dim jj As Integer
    Dim i  As Integer
    Dim iR As Variant   '修正(エラー値になる場合がある)
    Dim k  As Integer

    '転記処理
      Month = 5             '  5 月
      Num = Month - 4 + 8
      If Num <= 7 Then      ' ※労務費シートの列の値に合わせ修正
          Num = Num + 12
      End If
    '予算管理表のD列に"100以上"がセットされている行を見つけて業務を特定する
      For i = 43 To 1000
            '着目行の値
            n = wsYosan.Cells(i, 4).Value
            If n > 100 Then
                '業務番号取得
                pjNoY = wsYosan.Cells(i, 5).Value
                iR = Application.Match(pjNoY, wsRoumu.Range("B61:B82"), 0)  '追加(iRの値を定義)
                If Not IsError(iR) Then
                    '予算管理シートから 労務シートに実績をコピー
                    j = 8 'H列から
                    jj = Num '実績最終(×S)列まで
                    For k = j To jj
                        wsRoumu.Cells(iR + 60, k - 1).Value = wsYosan.Cells(i + 3, k).Value 'Q . 労務シートの61 ? 82行の該当月にコピー
                    Next k
                    Exit For
                End If
            ElseIf n = "End" Then
                Application.StatusBar = False
                'ループ終了
                Exit For
            End If
        Next i
    Application.DisplayAlerts = False
    'ブックを保存
    wbYosan.Save
    'ブックを閉じる
    wbYosan.Close
    Application.DisplayAlerts = True
 End Sub

'予算管理シートに見込み(実績月より後?翌3月まで)をコピー
Sub test()

    Dim iY As Long
  '転記元
    Dim wsRoumu As Worksheet
    If True Then             'wsRoumuの枝分かれ用条件式
        Set wsRoumu = wbRoumu.Worksheets("労務費(△△)")
    Else
        Set wsRoumu = wbRoumu.Worksheets("労務費(□□)")
    End If

  '転記先を設定
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\ サンプル労務シート"
    Dim wbYosan As Workbook
    Set wbYosan = Workbooks.Open(FileName)
    Dim wsYosan As Worksheet
    Set wsYosan = Worksheets("予算管理シート")
  '変数
    Dim pjNoY  As Integer   '予算シートの業務番号
    Dim pjNoR  As Integer   '労務シートの業務番号
    Dim n      As Variant
    Dim Month  As Integer   '入力月()
    Dim Num    As Integer   ' 実績月の列
    Dim rMonth As Integer   '読み込み始める列番号
    Dim i As Integer

    Month = 5 '  5 月
    Num = Month - 4 + 8
    If Num <= 5 Then
        Num = Num + 12
    End If

    rMonth = Num - 1 + 1 'ブック・シート間のずれで-1、翌月で+1 '5月=  労務H列 予算I列
    '業務番号取得
      For i = 33 To 54 '労務シート33?54 行までの実績月翌月?3月までをコピー
        pjNoR = wsRoumu.Cells(i, 2).Value
        iY = Application.Match(pjNoR, wsRoumu.Range("E5:E1000"), 0)  '追加(iYの値を定義)
        '
        '
        '
        End If
      Next
End Sub

(作業員) 2022/06/30(木) 11:13


Dictionaryを使ったマクロです。
御口に合いますかどうか。

 Sub Sample()
    Dim dic As Object
    Dim TargetMonth As Long
    Dim oColumn As Long
    Dim buf As Boolean
    Dim i As Long

    Select Case ActiveSheet.Name
        Case "労務費(△△)", "労務費(□□)": buf = True
        Case "サンプル予算管理":                 buf = False
        Case Else
            MsgBox "This Worksheet is Invalid."
            Exit Sub
    End Select

    TargetMonth = Val(InputBox("基準月を入力"))
    If TargetMonth < 1 Or TargetMonth > 12 Then
        MsgBox "Input Value is invalid."
        Exit Sub
    End If

    Set dic = GetDataDic(buf, TargetMonth)
    oColumn = (TargetMonth + 8) Mod 12

    If buf Then
        Dim ws As Worksheet
        oColumn = oColumn + 1
        For Each ws In Worksheets
            For i = 61 To 82
                If dic.exists(ws.Cells(i, 2).Value) Then
                    ws.Cells(i, 7).Resize(, oColumn).Value = dic(ws.Cells(i, 2).Value)
                End If
            Next
        Next
    Else
        Dim lastRow As Long
        lastRow = Cells(Rows.Count, "E").End(xlUp).Row
        For i = 5 To lastRow Step 12
            If dic.exists(Cells(i, 5).Value) Then
                Cells(i + 3, 8).Offset(, oColumn).Resize(, 12 - oColumn).Value = dic(Cells(i, 5).Value)
            End If
        Next
    End If
 End Sub

 Function GetDataDic(YosanOrRoumu As Boolean, TargetMonth As Long) As Object
    Dim dic As Object
    Dim rng As Range
    Dim buf As String
    Dim FilePath As String
    Dim FileName As String
    Dim SheetName() As String
    Dim TopRow    As Long
    Dim lastRow   As Long
    Dim oRow      As Long
    Dim oColumn   As Long
    Dim keyColumn As Long
    Dim OfsColumn As Long
    Dim RszColumn As Long
    Dim iStep     As Long
    Dim iRow As Long
    Dim i    As Long

    Select Case YosanOrRoumu
        Case True
            FileName = "サンプル予算管理"
            ReDim SheetName(0)
            SheetName(0) = "予算管理シート"
            TopRow = 5
            oRow = 3
            oColumn = 3
            keyColumn = 5
            OfsColumn = 0
            RszColumn = ((TargetMonth + 8) Mod 12) + 1
            iStep = 12
        Case False
            FileName = "サンプル労務シート"
            ReDim SheetName(1)
            SheetName(0) = "労務費(△△)"
            SheetName(1) = "労務費(□□)"
            TopRow = 33
            lastRow = 54
            oRow = 0
            oColumn = 5
            keyColumn = 2
            OfsColumn = (TargetMonth + 8) Mod 12
            RszColumn = 12 - OfsColumn
            iStep = 1
    End Select

    FilePath = ThisWorkbook.Path & "\" & FileName & ".xlsm"
    With Workbooks.Open(FilePath)
        Set dic = CreateObject("Scripting.Dictionary")
        For i = 0 To UBound(SheetName)
            With .Worksheets(SheetName(i))
                If YosanOrRoumu Then
                    lastRow = .Cells(Rows.Count, keyColumn).End(xlUp).Row
                End If
                For iRow = TopRow To lastRow Step iStep
                    Set rng = .Cells(iRow, keyColumn)
                    buf = rng.Value
                    If Not dic.exists(buf) Then
                        dic(buf) = rng.Offset(oRow, oColumn + OfsColumn).Resize(, RszColumn).Value
                    End If
                Next
            End With
        Next
        .Close
    End With
    Set GetDataDic = dic
 End Function

(作業員) 2022/06/30(木) 18:04


もこな2さん
ご回答ありがとうございます。
説明が下手で申し訳ないのですが、、追記いたしました。

■1
↓はどのような狙いがあるのですか?

 Month = 5 '  5 月
 Num = Month - 4 + 8
 If Num <= 5 Then
     Num = Num + 12
 End If
 rMonth = Num - 1 + 1
対象年月がわかれば、G列(2022年4月)から数えて何列目か計算すればよいだけでは?
さらに、Match関数や、Findメソッドなんかでも【列】は特定できるのでは?
→month(入力月)を変更するだけで何列目か指定することができたらと思ったのですが、
もっとシンプルな方法がありそうですね。
E列の業務番号が一致したら3行下(労務費)の該当の列を指定する方法がわからず複雑に考えてしまったかもです。

ちなみにMatch関数やFindを活用する際、検索値は列や変数などを入れること可能でしょうか。
■2
「Dim wbYosan As Workbook」の宣言はあれども、取得してないからNothingのままですよね。
SaveもCloseもできないですよ。
同時に↓は

 Set wsYosan = Worksheets("予算管理シート")
 Set wsYosan = ActiveWorkbook.Worksheets("予算管理シート")
↑のように解釈されるんじゃないでしょうか?それでいいんですか?
◆失礼しました。
Dim wbYosan As Workbook
Set wbYosan = Workbooks("サンプル予算管理")
でよろしいでしょうか?初歩的な質問で申し訳ございません。

■3
↓の意味が分かりません
>'Q.労務費(△△)、労務費(□□)のどちらかに枝分かれする形にしたい
シートを特定する情報がどこかにあるのではありませんか?

 例えばG5セルや、G17セルの内容から"業務〜"を除いたものが条件になるとか・・・

◆予算管理シートにはすべての業務番号が格納されています
転記する際にどちらかのシートにいって一致する業務番号の行に情報を転記したいです。
>シートを特定する情報がどこかにあるのではありませんか?
特に特定する内容はなく業務番号が一致するかどうかで振り分けという形です。

■4
↓の意味が分かりません。
>'予算管理表のD列に"100以上"がセットされいてる行を見つけて業務を特定する
画像を見る限りD列には何もなさそうですが・・・
むしろ、E5、E17、E29・・・と12行おきに業務番号と呼称している【文字列】が入っているように見えます
それを踏まえると↓は問題がないのでしょうか?

 Dim pjNoY As Integer
 pjNoY = wsYosan.Cells(i, 5).Valu

◆失礼いたしました。D列に数字の入っていないものを添付していました。
 E列から業務番号を抜き出すのに業務番号の下に「売上」「外注費」・・・など数字以外の要素が入っていたのでD列を使って100以上がセットされたらE列の値を取得している形です。

■5
↓の狙いはなんですか?

 pjNoR = wsRoumu.Cells(iR, 2).Value
 wsRoumu.Cells(iR, Num - 1).Value = 〜〜
「iR」の宣言がないので、Valiant型の初期値であるemptyになっていると思いますが、そんな行は無いから該当するセルが無いって怒られると思いますよ。
◆失礼しました。別シートの行数(業務番号)を変数で指定するにはどいしたら良いかと思いまして途中になってしまっていました。

■6
↓の狙いはなんですか?

 j = 8 'H列から
 jj = 19 'S列まで
 For k = j To jj
↓と同じことですよね。一旦変数に格納することで、かえって分かりづらくなりませんか?
 For k = 8 To 19 'H〜S列まで
◆確かにそうですよね。失礼しました。

■7
↓の狙いはなんですか?

 Application.StatusBar = False
ステータスバーをいじってもないのに元に戻すんですか?
◆失礼いたしました。進捗状況の部分を消したのにステータスバーを削除し忘れていました。

(ひろし) 2022/06/30(木) 20:14


作業員さんありがとございます。
解読に時間がかかりそうなので取り急ぎお礼まで。
疑問点出てきたら質問させていただいてよろしいでしょうか。

お手数をおかけしますがよろしくお願いいたします。
(ひろし) 2022/06/30(木) 20:16


正直私には。まだピンと来てないのですがお返事いただいたので一応。

■8
>month(入力月)を変更するだけで何列目か指定することができたらと思ったのですが、もっとシンプルな方法がありそうですね。
仰ってることがよくわかりません。
たとえば、労務費(△△)シートの60行目の中から"2022-05"という値のセルを探すならFindメソッドやMatch関数が使えますよねって話ですが・・・
繰り返しになりますが"年月"がわかれば"2022-05"って文字列は得られますよね。

 もしかして、「 Month = 5」はテスト用で運用時には任意で逐一入力する予定だったってことですか?

>E列の業務番号が一致したら3行下(労務費)の該当の列を指定する方法がわからず複雑に考えてしまったかもです。
理解ができません。(シートとセル番地を用いて)具体例で説明してください。

>〜でよろしいでしょうか?
多分いいんじゃないですか?ご自身で検証してください。

■9
>ちなみにMatch関数やFindを活用する際、検索値は列や変数などを入れること可能でしょうか。
可能です。

■10
>転記する際にどちらかのシートにいって一致する業務番号の行に情報を転記したいです。
>特に特定する内容はなく業務番号が一致するかどうかで振り分けという形です。

聞き方が良くなかったです。
【サンプル予算管理.xls?】→【サンプル労務シート.xls?】の処理について、【労務費(△△)】【労務費(□□)】どちらに書き込むのかを特定するのはどの情報を使うのかという話でした。

私はてっきり、予算管理シートのG5セルに"△△業務(2021年度)"とあるので、こういった情報を使えばよいのだと思いましたが違うのですね。
【労務費(△△)】【労務費(□□)】それぞれのB列をチェックして労務番号があるかどうか調べないと対象シートが特定できないということであってますか?

ちょっと時間が無いのでとりあえず3点だけ。

(もこな2) 2022/07/01(金) 08:05


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.