ganbaruzo
@ganbaruzo

Are you sure you want to delete the question?

If your question is resolved, you may close it.

Leaving a resolved question undeleted may help others!

We hope you find it useful!

ExcelVBAで簿記的な勘定科目を転記したい

ExcelVBAで簿記的な勘定科目をmainシートと、明細シートを参照して、明細シートに勘定科目を転記したいのですが、勘定科目をi4:i10が正しいのですが、実行すると明細シートの上から下の順に順番に勘定科目がなってしまいます。i4:i10の正しい順にするには、どうすれば良いでしょうかよいでしょうか?
大変、お手数ですが、どなたかご教示頂けないでしょうか?VBA初心者と、初投稿なので、投稿がいたらなかったら、すみません。

mainシート.jpg
明細シート2.jpg

‘ Sub 勘定科目転記()
Dim j As Lon
dim maxrow as long

maxrow = Cells(Rows.Count, 1).End(xlUp).Row

For j = 4 To maxrow

If ThisWorkbook.Sheets("明細").Cells(j, 1).Value = Worksheets("main").Cells(j, 2).Value Then

   Worksheets("明細").Cells(j, 5) = ThisWorkbook.Sheets("main").Cells(j, 3)

Else
Worksheets("明細").Cells(j, 5) = ThisWorkbook.Sheets("main").Cells(j, 2).Offset(0, 1)

End If
Next j

End Sub ‘

ネット検索

0

4Answer

excel vba の勉強なら関係のない話になりますが、「vlookup」とか使用する方が簡単ではないですか?

0Like

Comments

  1. @ganbaruzo

    Questioner

    ありがとうございます-。実際、vlooukpで値を返して、削除して、やってます。そうなんですけど、どうしてもVBAでしたいんですよねー。勉強の為にー。
  2. 「明細シートの品名名称」をキーにし「mainシートの検索文字列」と一致させて「mainシートの勘定科目」を取得し「明細シートの勘定科目」に設定をしたいのですよね?

    「明細シートの品名名称」が「支払手形」の場合、「mainシートの検索文字列」から「支払手形」を探す必要があります。
    プログラム的には「mainシートの検索文字列」を「現金」から順に比較し「一致もしくは最終行まで」確認をする必要があります。

    プログラムを確認する限り、「mainシートの検索文字列」を「現金」から順に比較し「一致もしくは最終行まで」を確認する処理がありません。
    ※明細シートの for と mainシートの文字列を探す for の二つのループが必要になるかと思います

  3. @ganbaruzo

    Questioner

    はい。二重ループですかねー。ありがとうございますー。初心者なので、具体的コードがないと、分かりません。officetanakaさんの、if文で、=TRUEの時、TRUEが返ると、youtubeで、載ってました。引き継き検索してみますー。

最低限2重ループにする必要があります。
下記サイトが、VBAでVLOOKUP関数に近いことをしています。

0Like

Comments

  1. @ganbaruzo

    Questioner

    ありがとございます。このサイト知ってます。コードが長いのと、今のレベルでは理解できませんでした。教えて頂いてるのにすみません。一旦、これは保留して置きます。

最低限2重ループにする必要があります。
勘定科目を検索する部分は関数を分けるようにしてあります。

Sub 勘定科目転記()
    Dim j As Long
    Dim maxrow As Long
    Dim master As String
    
    maxrow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
    
    For j = 4 To maxrow
        master = GetMaster(ThisWorkbook.Sheets("明細").Cells(j, 1).Value, 4)
        Worksheets("明細").Cells(j, 5) = master
    Next j

End Sub

Function GetMaster(target As String, startrow As Long) As String
    Dim i As Long

    GetMaster = ""
    maxrow = Worksheets("main").Cells(Rows.Count, 2).End(xlUp).Row
    For i = startrow To maxrow
        If target = Worksheets("main").Cells(i, 2).Value Then
            GetMaster = ThisWorkbook.Sheets("main").Cells(i, 3)
            Exit For
        End If
    Next

End Function
0Like

Comments

  1. @ganbaruzo

    Questioner

    自分が意図した通りのコードです。Functionもいるんですねー。初心者の自分にとっては、全然手に届かないレベルです。親切に回答して下さり、真に有難うございました。大変助かりました。Functionも今、ちょっとずつ勉強中です。

データ量にもよるのですが、科目の一覧を何度もLoopしたくないのであれば、
はじめに、科目の一覧を一度Loopし、keyが検索文字列、valueが科目の
連想配列の形で保持しておくのが良いと思います。
あとは、明細をループしながら、連想配列を参照していくかたちです。

連想配列もしくはScripting.Dictionaryで調べると出てきます。

0Like

Comments

  1. @ganbaruzo

    Questioner

    ありがとございますー。一度 、連想配列、かじったのですが、まだまだ、難しいですー。情報、有難いですー。
  2. 再回答の仕方がわからなかったので、コメントでコードを送ります。
    見にくくてすみません。

    Option Explicit

    Sub 勘定科目転記()

    Const startRow = 4
    Const targetColumn = 5
    Const accountColumn = 1
    Const updateColumn = 5

    Dim maxRow As Long
    Dim i As Long
    Dim dataSheet As Worksheet: Set dataSheet = ThisWorkbook.Sheets("明細")
    Dim masterSheet As Worksheet: Set masterSheet = ThisWorkbook.Sheets("main")

    maxRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row

    Dim accountDic As Object
    Set accountDic = CreateObject("Scripting.Dictionary")
    Call getMaster(accountDic, masterSheet, 4, 2)

    For i = 4 To maxRow
    dataSheet.Cells(i, targetColumn) = accountDic.Item(dataSheet.Cells(i, accountColumn).Value)
    Next i

    End Sub

    Function getMaster(dictionary As Object, targetSheet As Worksheet, startRow As Long, keyColumn As Long)

    Dim i: i = startRow

    Do
    If targetSheet.Cells(i, keyColumn) = "" Then Exit Do
    dictionary.Add targetSheet.Cells(i, keyColumn).Value, targetSheet.Cells(i, keyColumn + 1).Value
    i = i + 1
    Loop

    End Function

    限定公開記事にいれておきました。
    https://qiita.com/yamagoo1205/private/9dbbf9f0eac38909be91
  3. @ganbaruzo

    Questioner

    親切にありがとうございますー。

Your answer might help someone💌