Excel VBA質問箱 IV

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

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


4076 / 13644 ツリー ←次へ | 前へ→

【58372】Arrayの使い方について taichi 08/10/21(火) 21:37 質問[未読]
【58374】Re:Arrayの使い方について neptune 08/10/21(火) 22:15 発言[未読]
【58384】Re:Arrayの使い方について taichi 08/10/22(水) 21:32 質問[未読]
【58386】Re:Arrayの使い方について Hirofumi 08/10/22(水) 21:58 発言[未読]
【58407】Re:Arrayの使い方について Hirofumi 08/10/23(木) 22:38 発言[未読]
【58399】Re:Arrayの使い方について kanabun 08/10/23(木) 14:27 発言[未読]
【58458】Re:Arrayの使い方について taichi 08/10/27(月) 7:15 質問[未読]
【58459】Re:Arrayの使い方について kanabun 08/10/27(月) 10:09 発言[未読]
【58558】Re:Arrayの使い方について taichi 08/10/29(水) 22:27 お礼[未読]

【58372】Arrayの使い方について
質問  taichi  - 08/10/21(火) 21:37 -

引用なし
パスワード
   経理処理を「会計専用ソフト」を使って、エクセル上で再集計をしています。
勘定科目を具体的にArrayを活用し(91勘定科目数)て拾い出し、集計しています。
非常に僅かですが、常時使う登録された勘定科目以外の「勘定科目名」を
つけて、会計ソフトに手うち入力される場合があります。
この場合、Arrayに登録した処理の対象外になり、PIckUpしません。
Arrayの対象外を『その他』という科目で一まとめに纏めて集計させるには、
どのような方法があるのでしょうか?

現在Arrayの対象は下のような感じでコードを書いています。

Sub 勘定科目仕訳一覧表作成 ( )

Dim i As Integer, j As Integer, k As Integer, m As Integer, 勘定科目
As Variant, 摘要 As String
With Sheets("sheet2")
  .Range("A2", .Range("E2000")).ClearContents
 End With

勘定科目 = Array("", "入金票",  "交換小切手", "先付小切手",  "福利
厚生積立金", "退職積立金", "受取手形", "売掛金", "未収金", "支払手形
", "買掛金", "未払金", ", "給料", "賞与", "退職金", "法定福利費", "福
利厚生費", "旅費交通費", "通信費", "運賃", "広告宣伝費"・・・・・など
91の勘定科目があります)

k = 0
Eline: m = k + 1
  For i = m To 91
    摘要 = 勘定科目(i)
      With Sheets("sheet1").Range("A6").Offset(, 8)
        .AutoFilter field:=5, Criteria1:=摘要
      k = k + 1
      If Range("A" & Rows.Count).End(xlUp).Value = "伝票日付"
Then       
       GoTo Eline
      End If
    Range("A6", Range("Q" & Rows.Count).End(xlUp)).SpecialCells(
xlCellTypeVisible).Select   
    Selection.Copy Sheets("sheet2").Range("A" & Rows.Count).End(
xlUp).Offset(2)
     .AutoFilter
    End With
  Next i
Sheets("sheet1").Range("A6").Offset(, 8).AutoFilter
    :
    :
    :
  

【58374】Re:Arrayの使い方について
発言  neptune  - 08/10/21(火) 22:15 -

引用なし
パスワード
   ▼taichi さん:
こんにちは

私ならって事で。
>経理処理を「会計専用ソフト」を使って、エクセル上で再集計をしています。
>勘定科目を具体的にArrayを活用し(91勘定科目数)て拾い出し、集計しています。
>非常に僅かですが、常時使う登録された勘定科目以外の「勘定科目名」を
>つけて、会計ソフトに手うち入力される場合があります。
>この場合、Arrayに登録した処理の対象外になり、PIckUpしません。
>Arrayの対象外を『その他』という科目で一まとめに纏めて集計させるには、
>どのような方法があるのでしょうか?
VBAではなく、Excelの標準機能の一般操作で、先ずどうやってやるかって事も
考えると思います。Excelの標準機能は速いですから。

いろんな方法があるでしょうが、
先ず、フィルタオプションで抽出、その後表示セルのみを利用して集計
ってのが頭に浮かびました。

以上思い付きでした。

【58384】Re:Arrayの使い方について
質問  taichi  - 08/10/22(水) 21:32 -

引用なし
パスワード
   ▼neptune さん:
今晩は、taichi です

>いろんな方法があるでしょうが、
>先ず、フィルタオプションで抽出、その後表示セルのみを利用して集計
>ってのが頭に浮かびました。
>以上思い付きでした。
早速、ご回答有難うございました。その通りですね。実際にやってみましたが…
時間がかかり=91の勘定科目があり>>>マクロになってしまいました。

現実には、問題なくこなせているのですが、時たま、事前にArrayの対象にしていない「勘定科目」が
出たときに集計上、経理のソフトの集計とエクセルで分類しなおした集計との誤差がでてしまいます。

そのためにArrayの対象外の「勘定科目」を一まとめに、例えば「その他」(登録勘定科目以外)という項目で纏める方法がないか?っと思い質問しました。
良いアイディアがありましたらアドバイスお願いします。

【58386】Re:Arrayの使い方について
発言  Hirofumi  - 08/10/22(水) 21:58 -

引用なし
パスワード
   長く成るけどこんな事?

詳しく見てないので合っているのか解りませんが?
コード的には、Sheet1のデータを「勘定科目」と言う配列変数の順番に、
Sheet2にCopyして居るだけなのかな?
だとすれば、Sheet1のデータを丸ごとSheet2にCopyして
最終列の後ろを作業列とし、其処に「勘定科目の順番に番号を入れて整列(ソート)すれば善いかも?

Option Explicit

Public Sub Sample()

  '◆データ列数(A列〜Q列)
  Const clngColumns As Long = 17
  '◆勘定科目の列を指定(基準列からの列Offsetで指定:E列=4)
  Const clngItems As Long = 4
  
  Dim i As Long
  Dim j As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntData As Variant
  Dim vntItems As Variant
  Dim lngCount As Long
  Dim strProm As String

  '◆Sheet1の先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("Sheet1").Cells(6, "A")
  
  '◆Sheet2の先頭セル位置を基準とする
  Set rngResult = Worksheets("Sheet2").Cells(2, "A")

  '画面更新を停止
  Application.ScreenUpdating = False
  
  With rngResult
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows > 0 Then
      '結果を消去
      .Offset(1).Resize(lngRows, clngColumns).ClearContents
    End If
  End With
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '勘定科目の列の値を配列に取得
    vntData = .Offset(1, clngItems).Resize(lngRows + 1).Value
    'Sheet1をSheet2にCopy
    .Offset(1).Resize(lngRows + 1, clngColumns).Copy Destination:=rngResult
  End With
  
  vntItems = Array("", "入金票", "交換小切手", "先付小切手", _
          "福利厚生積立金", "退職積立金", "受取手形", _
          "売掛金", "未収金", "支払手形", "買掛金", _
          "未払金", "給料", "賞与", "退職金", _
          "法定福利費", "福利厚生費", "旅費交通費", _
          "通信費", "運賃", "広告宣伝費", "・・・・・など91の勘定科目があります")
  
  '整列Keyを作成
  For i = 1 To lngRows
    '勘定科目配列に値が有るかを確認
    For j = 1 To UBound(vntItems)
      If vntItems(j) = vntData(i, 1) Then
        Exit For
      End If
    Next j
    '整列Keyを配列に出力
    vntData(i, 1) = j
  Next i

  With rngResult
    '整列KeyをSheet2に出力
    .Offset(, clngColumns).Resize(lngRows).Value = vntData
    '整列Keyでデータを整列
    .Resize(lngRows, clngColumns + 1).Sort _
        Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '整列Keyを配列に再取得
    vntData = .Offset(, clngColumns).Resize(lngRows + 1).Value
    '整列Keyを上から見て行く
    lngCount = lngRows - 1
    For i = 1 To lngRows
      '整列Keyの番号が下の行と変わったら
      If vntData(i, 1) <> vntData(i + 1, 1) Then
        '最終行の下に列見出しと番号を出力
        lngCount = lngCount + 1
        .Offset(lngCount, clngColumns).Resize(2).Value = vntData(i, 1) - 0.5
        lngCount = lngCount + 1
        rngList.Resize(, clngColumns).Copy Destination:=.Offset(lngCount)
      End If
    Next i
    '整列Keyでデータを整列
    .Resize(lngCount + 1, clngColumns + 1).Sort _
        Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '整列Keyを消去
    .Offset(1, clngColumns).EntireColumn.ClearContents
  End With
  
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

【58399】Re:Arrayの使い方について
発言  kanabun  - 08/10/23(木) 14:27 -

引用なし
パスワード
   ▼taichi さん:

おじゃまします。
Hirofumi さんの Sort案、速そうですね(^^
真似をして 勘定科目をDictionaryに入れて作業列でソート案です。

Sub 勘定科目仕訳一覧表作成dicSort()
  Dim dic As Object
  Dim WB As Workbook
  Dim WS1 As Worksheet
  Dim WS2 As Worksheet
  Dim 勘定科目
  Dim v
  Dim i As Long, m As Long, TargetCol As Long, n As Long
  
  
 '(1)勘定科目リストを dicに入れる
   勘定科目 = Array("", "入金票", "交換小切手", "先付小切手", _
   "福利厚生積立金", "退職積立金", "受取手形", "売掛金", _
   "未収金", "支払手形", "買掛金", "未払金", "給料", _
   "賞与", "退職金", "法定福利費", "福利厚生費", _
   "旅費交通費", "通信費", "運賃", "広告宣伝費",・・・・・など)
   
   Set dic = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(v)    '配列0番目はSkip
     dic(勘定科目(i)) = i
   Next
   dic("その他") = i       '「その他」科目を追加
 
 '(2)元SheetのCopy
   Set WB = ActiveWorkbook
   Set WS1 = WB.Sheets("Sheet1")
   Set WS2 = WB.Worksheets.Add(After:=WS1)
   With WS1
     m = .Range("A6").CurrentRegion.Columns.Count
     .Range("A6", .Cells(.Rows.Count, 1).End(xlUp)). _
      Resize(, m).Copy WS2.Range("A1")
   End With
   
 
 '(3)対象列の科目の調査 → 作業列に 科目番号を挿入
   TargetCol = 5      '<--- 対象列番号 '★★★要変更
   With WS2.Range("A1").CurrentRegion
     m = .Columns.Count
     v = .Columns(TargetCol).Cells.Value
     v(1, 1) = "作業列"
     For i = 2 To UBound(v)
       If dic.Exists(v(i, 1)) Then
         v(i, 1) = dic(v(i, 1))
       Else
         v(i, 1) = dic("その他")
       End If
     Next
     .Columns(m + 1).Value = v
     With .Item(.Rows.Count + 1, m + 1)  '空白行の挿入
       .Value = 1
       .DataSeries xlColumns, Step:=1, Stop:=dic("その他")
     End With
   End With
   With WS2.Range("A1").CurrentRegion
     .Sort Key1:=.Columns(m + 1), Header:=xlYes
     '.Columns(m + 1).ClearContents
   End With
   
 Set dic = Nothing
 Set WS1 = Nothing
 Set WS2 = Nothing
 Set WB = Nothing
End Sub

【58407】Re:Arrayの使い方について
発言  Hirofumi  - 08/10/23(木) 22:38 -

引用なし
パスワード
   やっている事はさして変わんないけど
この方が幾らかスマートかな?(幾分速く成るかも?)

Option Explicit

Public Sub Sample2()

  '◆データ列数(A列〜Q列)
  Const clngColumns As Long = 17
  '◆勘定科目の列を指定(基準列からの列Offsetで指定:E列=4)
  Const clngItems As Long = 4
  
  Dim i As Long
  Dim j As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntData As Variant
  Dim vntItems As Variant
  Dim vntItem As Variant
  Dim lngCount As Long
  Dim blnOthers As Boolean
  Dim strProm As String

  '◆Sheet1の先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("Sheet1").Cells(6, "A")
  
  '◆Sheet2の先頭セル位置を基準とする
  Set rngResult = Worksheets("Sheet2").Cells(2, "A")

  '画面更新を停止
  Application.ScreenUpdating = False
  
  vntItems = Array("", "入金票", "交換小切手", "先付小切手", _
          "福利厚生積立金", "退職積立金", "受取手形", _
          "売掛金", "未収金", "支払手形", "買掛金", _
          "未払金", "給料", "賞与", "退職金", _
          "法定福利費", "福利厚生費", "旅費交通費", _
          "通信費", "運賃", "広告宣伝費", "・・・・・など91の勘定科目があります")
          
  With rngResult
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows > 0 Then
      '結果を消去
      .Offset(1).Resize(lngRows, clngColumns).ClearContents
    End If
  End With
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'Sheet1をSheet2にCopy
    .Offset(1).Resize(lngRows + 1, clngColumns).Copy Destination:=rngResult
  End With
  
  With rngResult
    '勘定科目の列をKeyとして整列
    .Resize(lngRows, clngColumns).Sort _
        Key1:=.Offset(, clngItems), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '勘定科目の列を配列に取得
    vntData = .Offset(, clngItems).Resize(lngRows + 1).Value
  End With
  
  '整列Keyを作成
  lngCount = lngRows - 1
  For i = 1 To lngRows + 1
    '勘定科目が違ったら
    If vntItem <> vntData(i, 1) Then
      vntItem = vntData(i, 1)
      '勘定科目配列に値が有るかを確認
      For j = 1 To UBound(vntItems)
        If vntItems(j) = vntData(i, 1) Then
          Exit For
        End If
      Next j
      If j <= UBound(vntItems) Or blnOthers = False Then
        '最終行の下に列見出しと番号を出力
        lngCount = lngCount + 1
        rngResult.Offset(lngCount, clngColumns).Resize(2).Value = j - 0.5
        lngCount = lngCount + 1
        rngList.Resize(, clngColumns).Copy _
            Destination:=rngResult.Offset(lngCount)
      End If
      If j > UBound(vntItems) Then
        blnOthers = True
      End If
    End If
    '整列Keyを配列に出力
    vntData(i, 1) = j
  Next i

  With rngResult
    '整列KeyをSheet2に出力
    .Offset(, clngColumns).Resize(lngRows).Value = vntData
    '整列Keyでデータを整列
    .Resize(lngCount + 1, clngColumns + 1).Sort _
        Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '整列Keyを消去
    .Offset(1, clngColumns).EntireColumn.ClearContents
  End With
  
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

【58458】Re:Arrayの使い方について
質問  taichi  - 08/10/27(月) 7:15 -

引用なし
パスワード
   ▼hirofumiさん kanabun さん:

貴重なご回答頂きまして有難うございます。
質問の仕方が今一だったと、反省しています。
やはり例示した方が良かったと思っています。

勘定科目をDictionaryに入れての…は思いつきませんでした。
重複をさせずに、勘定科目をKeyにしてやれば出来そうですね。
一度トライしてみます。

kanabunさんの
このコードに興味を持ちました。が
UBound(v)のところでエラーになります。
何か問題があるのでしょうか?

>   Set dic = CreateObject("Scripting.Dictionary")
>   For i = 1 To UBound(v)    '配列0番目はSkip
>     dic(勘定科目(i)) = i
>   Next
>   dic("その他") = i       '「その他」科目を追加
> 
お時間が許せばアドバイスお願いします。

【58459】Re:Arrayの使い方について
発言  kanabun  - 08/10/27(月) 10:09 -

引用なし
パスワード
   ▼taichi さん:
こんにちは。
> kanabunさんの
> このコードに興味を持ちました。が
> UBound(v)のところでエラーになります。
> 何か問題があるのでしょうか?
>
>>   Set dic = CreateObject("Scripting.Dictionary")
>>   For i = 1 To UBound(v)    '配列0番目はSkip
>>     dic(勘定科目(i)) = i
>>   Next
>>   dic("その他") = i       '「その他」科目を追加
>> 

すみませんね〜
そこは、
>(1)勘定科目リストを dicに入れる
> 勘定科目 = Array("", "入金票", "交換小切手", "先付小切手",
       ......
のところなので、
>> For i = 1 To UBound(v)    '配列0番目はSkip
でなく、
  For i = 1 To UBound(勘定科目)  '配列0番目はSkip
が正解でした。

また、シートレイアウトがよく分からなかったので、
・シート名や元データテーブルが6行目から始まっている、
・ソート対象列が左から数えて5列目
・表は空白列がない
など、適当な仮定を入れたサンプルですので、
そうでない場合は該当行を適切に編集する必要があります。

コードの注目行にブレークポイント[F9]を付して、その行で
コードの実行を一時中断させ、
[F8]キーで1行づつステップ実行しながら、その行がどういう処理を
しているか、またその行を実行することにより変数の内容が
どう変化しているか、変数にマウスを置いたり、ローカル
ウィンドウで変数の内容を調べながらデバッグしていくと
理解が速くなりますよ。

ではでは。

【58558】Re:Arrayの使い方について
お礼  taichi  - 08/10/29(水) 22:27 -

引用なし
パスワード
   ▼kanabun さん:
お忙しいところ、色々とご指導有難うございました。
今後とも宜しくお願いします。

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