Excel VBA質問箱 IV

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

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


23695 / 76732 ←次へ | 前へ→

【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

0 hits

【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 お礼

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