| |
▼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
|
|
kanabun
- 08/10/23(木) 14:27 -
