[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『期間の抽出』（信州）
日単位でｱｯﾌﾟﾃﾞｰﾄされる顧客管理のデータﾍﾞｰｽにおいて、週単位、月単位で年間を8つの期間に 分けて抽出し、 データを加工する必要に迫られています。InputBox形式で月単位での抽出方法はわかってい るのですが、その応用としての 期間抽出方法につまずいています。どなたか知恵を貸していただけませんか？ VBAのユーザーォーム形式で作成を考えています。
１：該当月の行の抽出
２：2006年1Q（2006年4月1日～6月30日の行） ３：2006年2Q（2006年7月1日～9月30日の行） ４：2006年3Q（2006年10月1日～12月31日の行） ５：2006年4Q（2007年1月1日～3月31日の行）
６：2006年上期（2006年4月1日～9月30日の行） ７：2006年下期（2006年10月1日～2007年3月31日の行）
８：通年（2006年4月1日～2007年3月31日の行）
A B C D
1 受付日 注文書No 顧客 品目
2 2007/2/4 06-1630 A店 食品
3 2007/1/23 06-1350 B店 家電
4 2007/1/5 06-1180 C店 飲料
5 2006/12/28 06-1105 D店 自動車
6 2006/11/3 06-0904 C店 衣類
7 2006/10/9 06-0806 B店 自動車
8 2006/9/8 06-0631 B店 食品
9 2006/8/8 06-0530 A店 家電
10 2006/7/3 06-0420 C店 お酒
11 2006/7/1 06-0406 A店 衣類
12 2006/6/30 06-0405 A店 食品
* 2006/6/** 06-03** * *
* 2006/6/** 06-03** * *
99 2006/6/18 06-0310 B店 自動車
100 2006/6/10 06-0298 A店 家電
101 2006/6/5 06-0235 C店 家電
102 2006/6/2 06-0202 D店 食品
103 2006/5/31 06-0158 A店 衣類
104 2006/5/15 06-0100 B店 家電
800 2006/5/5 06-0035 A店 家電
801 2006/4/20 06-0025 B店 食品
850 2006/4/18 06-0003 D店 食品
851 2006/4/10 06-0002 A店 飲料
840 2006/4/1 06-0001 A店 飲料
1:該当月の行抽出方法 (InputBox入力方法）
Sub てすと()
Dim mth As String
mth = InputBox("抽出する月は？")
With Sheets("Sheet1")
With .Range("A2", .Range("A65536").End(xlUp))
With .Offset(, 255)
.Formula = "=IF(YEAR(A2)&""/""&MONTH(A2)<>""" & mth & """,1,"""")"
' .Formula = "=IF(MONTH(A2)<>mth,1,"""")"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 17).EntireRow.Delete
On Error GoTo 0
End With
End With
End With
End Sub
Windows2000, EXCEL2000
マクロではございませんが、作業列を使いオートフィルターで行うのはいかがでしょう？
また、上記のコードは、該当以外のものを削除してしまっていますが
それでも宜しいのでしょうか？
試しに、Dictionary を使用する方法で、Sheet2 に抽出するものを作ってみました＾＾
（久々だから、どうだろう？）
Sub test()
Dim MyDic As Object
Dim MyA As Variant
Dim i As Long
Dim mth As String
Set MyDic = CreateObject("Scripting.Dictionary")
mth = InputBox("抽出する月は？")
With Worksheets("Sheet1")
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp))
MyDic(1) = Array(MyA(1, 1), MyA(1, 2), MyA(1, 3), MyA(1, 4))
For i = 2 To UBound(MyA, 1)
If Month(MyA(i, 1)) = mth Then
MyDic(i) = Array(MyA(i, 1), MyA(i, 2), MyA(i, 3), MyA(i, 4))
End If
Next i
End With
With Worksheets("Sheet2")
.Cells.ClearContents
.Range("A1").Resize(MyDic.Count, 4) = _
Application.Transpose(Application.Transpose(MyDic.Items))
End With
Erase MyA
Set MyDic = Nothing
End Sub
（キリキ）(〃⌒o⌒)b
早速のアドバイスありがとうございます。恥ずかしながら小生のVBAﾌﾟﾛｸﾞﾗﾐﾝｸﾞの知識は浅いのでDictionary を使用する方法で、 Sheet2 に抽出する方法までは思いつきませんでした。上記のサンプルは年間全部のデータがあった場合を想定して出したのですが、 実際には週単位で随時ｱｯﾌﾟﾃﾞｰﾄされるのでｵｰﾄﾌｨﾙﾀによる抽出方法のﾏｸﾛ形式での記録化対応できるか、疑問ですが・・ こちらがやった時はうまくいきませんでした。
ｵｰﾄﾌｨﾙのﾏｸﾛ化は成功し、試しに１Qのデータをsheet2にコピーするVBAを作成したのですが、エラーになりうまく動きませんでした。 どこに問題があるか教えて下さいますか？
Sub 年1Q()
Dim MyDic As Object
Dim MyA As Variant
Dim i As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp))
MyDic(1) = Array(MyA(1, 1), MyA(1, 2), MyA(1, 3), MyA(1, 4))
For i = 2 To UBound(MyA, 1)
If Month(MyA(i, 1)) = mth Then
MyDic(i) = Array(MyA(i, 1), MyA(i, 2), MyA(i, 3), MyA(i, 4))
End If
Next i
End With
Range("A2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=2006/4/1", Operator:=xlAnd, _
Criteria2:="<=2006/6/30"
Range("A12:D23").Select
Selection.Copy
With Worksheets("sheet2")
.Cells.ClearContents
.Range("A1").Resize(MyDic.Count, 4) = _
Application.Transpose(Application.Transpose(MyDic.Items))
End With
Sheets("sheet2").Select
Sheet2.Name = "2006年1Q"
Range("A2").Select
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Range("E13").Select
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("E1").Select
End Sub
信州
こんなんどうでしょうか？
ちょっとつかれました(^^;
(ROUGE)
'----
Sub Shinano()
Dim dic1 As Object, dic2 As Object, dic3 As Object, dic4 As Object
Dim dic5 As Object, dic6 As Object, dic7 As Object, dic8 As Object
Dim dic9 As Object, dic10 As Object, dic11 As Object, dic12 As Object
Dim kw As String, nen As Integer, syurui As String, tbl, itm
Dim i As Long, j As Integer, ws As Worksheet
Set dic1 = CreateObject("Scripting.Dictionary"): Set dic2 = CreateObject("Scripting.Dictionary")
Set dic3 = CreateObject("Scripting.Dictionary"): Set dic4 = CreateObject("Scripting.Dictionary")
Set dic5 = CreateObject("Scripting.Dictionary"): Set dic6 = CreateObject("Scripting.Dictionary")
Set dic7 = CreateObject("Scripting.Dictionary"): Set dic8 = CreateObject("Scripting.Dictionary")
Set dic9 = CreateObject("Scripting.Dictionary"): Set dic10 = CreateObject("Scripting.Dictionary")
Set dic11 = CreateObject("Scripting.Dictionary"): Set dic12 = CreateObject("Scripting.Dictionary")
kw = Application.InputBox(prompt:="何年のどのようなものを抽出しますか？" & Chr(10) & _
Chr(10) & "記入例）2006年度通年、2006年度第1Q、2006年度1月", Type:=2)
kw = StrConv(kw, vbNarrow): kw = StrConv(kw, vbUpperCase)
With CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
If Not .test(kw) Then: MsgBox ("年が指定されていません！"): Exit Sub
nen = Val(.Execute(kw)(0))
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"
If Not .test(kw) Then: MsgBox ("抽出する種類が指定されていません！"): Exit Sub
syurui = .Execute(kw)(0)
syurui = Replace(syurui, "/", "")
syurui = Replace(syurui, "月", "")
Select Case syurui
Case 1, 2, 3
If MsgBox(nen & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _
nen = nen - 1
End Select
End With
With Worksheets("Sheet1")
tbl = .Range("A2", .Range("D" & Rows.Count).End(xlUp))
End With
On Error Resume Next
With dic1
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 1 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic2
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 2 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic3
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 3 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic4
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 4 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic5
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 5 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic6
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 6 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic7
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 7 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic8
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 8 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic9
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 9 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic10
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 10 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic11
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 11 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic12
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 12 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
Erase tbl
Select Case syurui
Case "1"
With dic1
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "2"
With dic2
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "3"
With dic3
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "4"
With dic4
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "5"
With dic5
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "6"
With dic6
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "7"
With dic7
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "8"
With dic8
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "9"
With dic9
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "10"
With dic10
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "11"
With dic11
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "12"
With dic12
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "1Q"
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "2Q"
ReDim tbl(1 To dic7.Count + dic8.Count + dic9.Count, 1 To 4)
i = 0
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "3Q"
ReDim tbl(1 To dic10.Count + dic11.Count + dic12.Count, 1 To 4)
i = 0
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "4Q"
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count, 1 To 4)
i = 0
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "上期"
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count + dic7.Count + dic8.Count + dic9.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "下期"
ReDim tbl(1 To dic10.Count + dic11.Count + dic12.Count + dic1.Count + dic2.Count + dic3.Count, 1 To 4)
i = 0
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "通年"
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count + dic7.Count + dic8.Count + dic9.Count + _
dic10.Count + dic11.Count + dic12.Count + dic1.Count + dic2.Count + dic3.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
End Select
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
With ws
Err.Clear
.Name = nen & "年度" & syurui & IIf(IsNumeric(syurui), "月", "")
If Err.Number = 1004 Then _
.Name = nen & "年度" & syurui & IIf(IsNumeric(syurui), "月", "") & "_" & Format(Int(Rnd * 10000), "0000")
.Columns("A:D").ClearContents
.Range("A1:D1").Value = Array("受付日", "注文書No", "顧客", "品目")
.Range("A2").Resize(UBound(tbl, 1), 4).Value = tbl
.Columns("A:D").AutoFit
End With
On Error GoTo 0
Erase tbl: Set ws = Nothing
Set dic1 = Nothing: Set dic2 = Nothing: Set dic3 = Nothing: Set dic4 = Nothing
Set dic5 = Nothing: Set dic6 = Nothing: Set dic7 = Nothing: Set dic8 = Nothing
Set dic9 = Nothing: Set dic10 = Nothing: Set dic11 = Nothing: Set dic12 = Nothing
End Sub
あ、あの～、2000年より前のデータがもしあるようでしたら、改変が必要ですので・・・ (ROUGE)
信州さん、 キリキさんのコードと、信州さんが記録したコードが ごっちゃ混ぜになってませんか (seiya)
ROUGEさん、力作有難うございます！それにしてもすごいですね～。早速この雛型を参考にユーザーフォーム形式に変形できるか ﾁｬﾚﾝｼﾞしてみます。 seiyaさんへ・・・ご指摘の通り、キリキさんのコードとごちゃ混ぜにしていますが、いけないでしょうか？ ActiveSheet.Pasteのところでエラーになり、ｽﾄｯﾌﾟしてしまいます。
信州さん、 Clip boardがクリアされているはずです。 一緒にするなら、キリキさんのコードが終了した時点から まとめて追加した方がいいでしょう。
Copyしてからキリキさんの配列を吐き出した時点で、 CopyしたものはClip Boardからクリアされているはずです。 だからPaste出来ないのです。 (seiya)
コードをちょっと変えました。 ユーザーフォームでなくても、InputBoxで耐えれるように作ったつもりですが、、、 (ROUGE)
業務でやっている集計は今のところ、小生がやっていますが、夏休みとかで年休を取ったときに上司が代りにやるケースも想定して、 上司でも簡単にできる方法として｢ユーザーフォーム形式を考えているのですが。Inputbox形式だとどのように入力したらいいか わからないのでＭｓｇBox形式で入力方法を表示する方法もありますね。又、MsgBoxで該当番号を探し、それをInputboxで入力する 手もありますね。（この方法でもいいかな）
信州（標高1,000ｍ）
条件に合致するデータがない場合エラーが出るので、修正しました。 また、条件の記入例も追加しました。 ある程度フレキシブルに入力できますので、大丈夫だと思いますよ。 ２００６ １ｑと入力されても、２００６年の１０月と入力されても、２００６／５と入力 されても大丈夫です。 (ROUGE)
ROUGEさん、有難うございます。助かりました。これで次のステップに進めます。次のｽﾃｯﾌﾟは来週あたりに又投稿しますので、 その時も又宜しくお願いしますね。
ROUGEさん、VBAを解読していて判らない部分がでてきたので質問です。
①DIMの変数宣言のところ：Dim kw As String, nen As Integer, syurui As String, tbl, itm
tbl,itmはStringと理解していいでしょうか？
②With dic1
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 1 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
の意味がよく判りません。すみませんが、説明頂けますか？ m(_ _)m m(_ _)m
信州
(1) tbl、itmはVariant型です。 (2) 年度ごとなので、1～3月は単純にnenではだめで、+1しています。 しかし、2007/1とした場合、2007年度の1月か2007年1月かの判断をするために、 MsgBoxで分岐させています。 (ROUGE)
Rougeさんのプログラムを雛型として少し変えてみました。
1: InputBoxの表示内容と入力は全て数字のみ 例：2006/1Q -->2006/13
2007/1とinputして実行させると
Case "1"
With dic1
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
でエラーになり、ｽﾄｯﾌﾟしてしまいます。下記の記述のどこに問題があるかご教示下さいますか？
Sub 集計期間選択() Dim dic1 As Object, dic2 As Object, dic3 As Object, dic4 As Object Dim dic5 As Object, dic6 As Object, dic7 As Object, dic8 As Object Dim dic9 As Object, dic10 As Object, dic11 As Object, dic12 As Object Dim kw As String, nen As Integer, syurui As String, tbl, itm Dim i As Long, j As Integer
Set dic1 = CreateObject("Scripting.Dictionary"): Set dic2 = CreateObject("Scripting.Dictionary")
Set dic3 = CreateObject("Scripting.Dictionary"): Set dic4 = CreateObject("Scripting.Dictionary")
Set dic5 = CreateObject("Scripting.Dictionary"): Set dic6 = CreateObject("Scripting.Dictionary")
Set dic7 = CreateObject("Scripting.Dictionary"): Set dic8 = CreateObject("Scripting.Dictionary")
Set dic9 = CreateObject("Scripting.Dictionary"): Set dic10 = CreateObject("Scripting.Dictionary")
Set dic11 = CreateObject("Scripting.Dictionary"): Set dic12 = CreateObject("Scripting.Dictionary")
kw = Application.InputBox(prompt:="集計期間を入力して下さい -->入力例" & Chr(10) & _
Chr(10) & "2006/7" & " " & _
Chr(10) & "2006/13=1Q, 2006/14=2Q, 2006/15=3Q, 2006/16=4Q" & " " & _
Chr(10) & "2006/17=上期, 2006/18=下期, 2006/19=通年", Type:=2)
kw = StrConv(kw, vbNarrow): kw = StrConv(kw, vbUpperCase)
With CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
If Not .test(kw) Then: MsgBox ("入力されていません！"): Exit Sub
nen = Val(.Execute(kw)(0))
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"
If Not .test(kw) Then: MsgBox ("抽出する種類が指定されていません！"): Exit Sub
syurui = .Execute(kw)(0)
syurui = Replace(syurui, "/", "")
syurui = Replace(syurui, "月", "")
Select Case syurui
Case 1, 2, 3
If MsgBox(nen - 1 & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _
nen = nen - 1
End Select
End With
With Worksheets("Sheet1")
tbl = .Range("A2", .Range("D" & Rows.Count).End(xlUp))
End With
On Error Resume Next
With dic1
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 1 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic2
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 2 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic3
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 3 And Year(tbl(i, 1)) = nen + 1 Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic4
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 4 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic5
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 5 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic6
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 6 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic7
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 7 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic8
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 8 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic9
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 9 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic10
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 10 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic11
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 11 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
With dic12
For i = 1 To UBound(tbl, 1)
If Month(tbl(i, 1)) = 12 And Year(tbl(i, 1)) = nen Then _
.Add i, Array(tbl(i, 1), tbl(i, 2), tbl(i, 3), tbl(i, 4))
Next
End With
On Error GoTo 0
Erase tbl
Select Case syurui
Case "1"
With dic1
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "2"
With dic2
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "3"
With dic3
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "4"
With dic4
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "5"
With dic5
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "6"
With dic6
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "7"
With dic7
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "8"
With dic8
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "9"
With dic9
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "10"
With dic10
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "11"
With dic11
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "12"
With dic12
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "13" '1Q
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "14" '2Q
ReDim tbl(1 To dic7.Count + dic8.Count + dic9.Count, 1 To 4)
i = 0
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "15" '3Q
ReDim tbl(1 To dic10.Count + dic11.Count + dic12.Count, 1 To 4)
i = 0
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "16" '4Q
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count, 1 To 4)
i = 0
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "17" '上期
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count + dic7.Count + dic8.Count + dic9.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "18" '下期
ReDim tbl(1 To dic10.Count + dic11.Count + dic12.Count + dic1.Count + dic2.Count + dic3.Count, 1 To 4)
i = 0
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
Case "19" '通年
ReDim tbl(1 To dic4.Count + dic5.Count + dic6.Count + dic7.Count + dic8.Count + dic9.Count + _
dic10.Count + dic11.Count + dic12.Count + dic1.Count + dic2.Count + dic3.Count, 1 To 4)
i = 0
With dic4
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic5
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic6
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic7
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic8
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic9
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic10
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic11
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic12
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic1
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic2
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
With dic3
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
End Select
With Worksheets("Sheet2")
.Columns("A:D").ClearContents
.Range("A1:D1").Value = Array("受付日", "顧客", "品目", "入金")
.Range("A2").Resize(UBound(tbl, 1), 4).Value = tbl
End With
Erase tbl
Set dic1 = Nothing: Set dic2 = Nothing: Set dic3 = Nothing: Set dic4 = Nothing
Set dic5 = Nothing: Set dic6 = Nothing: Set dic7 = Nothing: Set dic8 = Nothing
Set dic9 = Nothing: Set dic10 = Nothing: Set dic11 = Nothing: Set dic12 = Nothing
End Sub
Case "1"・・・の部分でエラーが出る理由はすぐには分かりませんが、 単純にCaseの各四半期、上下期、通期の部分を数値に置き換えただけでは動きません。 Regluar Expressionの部分の改変が必要です。 (ROUGE)
Regluar Expressionの部分とは冒頭から最初のwith～End withのところまでを指しているのでしょうか？ 信州
そうです。 (ROUGE)
ひぇー！ROUGEさんの高度かつ洗練された記述の改変はとてもとても・・・ 特に最初のwith～End With内の理解が未だ今一です。
With CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
If Not .test(kw) Then: MsgBox ("年が指定されていません！"): Exit Sub
nen = Val(.Execute(kw)(0))
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"
If Not .test(kw) Then: MsgBox ("抽出する種類が指定されていません！"): Exit Sub
syurui = .Execute(kw)(0)
syurui = Replace(syurui, "/", "")
syurui = Replace(syurui, "月", "")
Select Case syurui
Case 1, 2, 3
If MsgBox(nen & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _
nen = nen - 1
End Select
End With
のところの冒頭部分
CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
の意味がよく判らないので説明頂けますか？ それとSet dic1 = CreateObject("Scripting.Dictionary") の
概念もよく判りません。 ROUGE先生！
VBAの超初心者 信州
RegExpはσ(^-^;)も初心なのですが・・・
CreateObject("VBScript.RegExp")
は、準備しているだけです。
VBE画面のツール-->参照設定 を選択し、Microsoft VBScript Regular Expressions 5.5
にチェックを入れてOKとすると、自動メンバ表示もされるようになります。
.Pattern は、調べる文字列をしていするもので、"20\d{2}" は、2000～2099を意味しています。
CreateObject("Scripting.Dictionary") も同様に参照設定から Microsoft Scripting Runtime
にチェックを入れてOKとすると、自動メンバ表示されるようになります。
(ROUGE)
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"のところをいじっていますが、￥の意味は演算子でしょうか？
Helpで調べてもよくわかりません。Helpでは整数除算と出ているのですが、今回の記述の意味と違う様な？
\d{1,2}の意味を教えて下さい。Rouge先生
webで「正規表現」を検索すればいろいろ出てきますよ(seiya)
衝突～☆ 本当の先生が出てきた～＾＾ 以下原文
先生はやめてくらはい。
\は通常演算子ですが、この場合は\dでセットで数字という意味です。
\d{1,2}は数字の1回くり返しか2回くり返しという意味です。
"(通年|[1-4]Q|(上|下)期|/([1-9]|1[0-2])$|([1-9]|1[0-2])月$)"
の方がよいかも...
(ROUGE)
上記に従い、InputBoxで入力したところ、通年、上期/下期、、2006年1Q～4Q、2006年4月～12月は正常に出ましたが、 2007年1月と入力すると2007年度の1月でよろしいですか？のﾒｯｾｰｼﾞが出てOKを押すと「ｲﾝﾃﾞｯｸｽが有効範囲にありません。」 というｴﾗｰﾒｯｾｰｼﾞが出てしまいます。又、2006年1月と入力した場合、2006年度の1月でよろしいですか？というﾒｯｾｰｼﾞが 出て2007年1月のデータが出てきます。2006年度1月と1字1句正確に入力しないと駄目ですね。 多少のラフな入力でも正確に認識してくれる方法はないかな？ 例えば20071、2007年1月と入力した場合これが2007年1月の データに反映されるという具合に・・2006年と認識したら、1月～3月は2005年度、
こちらの都合で上記の書きかけがｽﾄｯﾌﾟしてすみません。再開しますので、レスお願い申し上げます。 ROUGEさんの作ったルーチンは完成度が高く非常に気に入っています。そこで愚問ですが、
With CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
If Not .test(kw) Then: MsgBox ("年が指定されていません！"): Exit Sub
nen = Val(.Execute(kw)(0))
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"
If Not .test(kw) Then: MsgBox ("抽出する種類が指定されていません！"): Exit Sub
syurui = .Execute(kw)(0)
syurui = Replace(syurui, "/", "")
syurui = Replace(syurui, "月", "")
Select Case syurui
Case 1, 2, 3
If MsgBox(nen & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _
nen = nen - 1
End Select
End With
のtest(kw) ,nen = Val(.Execute(kw)(0))の意味がわからず解読がストップしています。 rougeさん、見ていたらご教示下さい。m(_ _)m m(_ _)m
お盆休みが近づいてうきうきの信州でした。
testメソッドは、引数の中にPatternがあるかどうかをBoolean型で返すものです。 Executeは、引数の中にPatternが合致するものをMacthコレクションとして持っています。 (0)で一番始めのものを持ってきています。 (ROUGE)
野暮な質問ですみませんが、
If Not .test(kw) Then: MsgBox ("年が指定されていません！"): Exit Sub
のtest部分を変数と思い、natsu(kw)に変えて記述したらエラーになりました。 それとPattenの定義がＶＢＡ関連書籍、helpの定義と異なっているようで混乱しています。 ここでいうPatternとはInputBoxに入力するTextのことを指しているのですね？
（信州）
Patternは正規表現であらわしている文字列で、""でくくられているものです。 Testメソッドで調べています。 σ(^-^;)はVBA関連書籍を持っていないので、正規表現があるのかどうか分かりませんが、 どっちかというとVBScript関連の方に載っているとおもいます。 HELPも確認しましたが、載っていなさそうですね＾＾； Webで調べた方が確実かもしれません。 http://www.mnet.ne.jp/~nakama/ ↑に正規表現のことが書かれていますので、参考までに・・・ (ROUGE)
ありがとうございます！こちらが買いあさったVBA関連の入門レベルの書籍には「正規表現」という高度な記述方法の解説が なく正規表現の使い方を今まで知らなかったので、大変勉強になります！目下、下記を解読中ですが、ぱーっと理解出来たような気がします。
"(通年|[1-4]Q|(上|下)期|/([1-9]|1[0-2])$|([1-9]|1[0-2])月$)"
たった1行でこれだけの選択肢を記述できるとはすごい！（ずいぶんと遅い感想ですみません。） 信州
2006/1,2006/2、2006/3と入力すると前年度にもかかわらず今年度と認識してしまう上に今年度のデータとして 2007/1、2007/2、2007/3と入力するとエラーになり、2007年1月と入力しないと認識しないので、それは何とかならないかな～と 考えています。
With CreateObject("VBScript.RegExp")
.Pattern = "20\d{2}"
If Not .test(kw) Then: MsgBox ("年が指定されていません！"): Exit Sub
nen = Val(.Execute(kw)(0))
.Pattern = "(通年|[1-4]Q|(上|下)期|/\d{1,2}|\d{1,2}月)"
If Not .test(kw) Then: MsgBox ("抽出する種類が指定されていません！"): Exit Sub
syurui = .Execute(kw)(0)
syurui = Replace(syurui, "/", "")
syurui = Replace(syurui, "月", "")
Select Case syurui
Case 1, 2, 3
If MsgBox(nen & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _
nen = nen - 1
End Select
End With
信州
> If MsgBox(nen & "年度の" & syurui & "月でよろしいですか？", vbYesNo) = vbNo Then _ ここを If MsgBox(nen & "年の" & syurui & "月でよろしいですか？", vbYesNo) = vbYes Then _ としたら、ご希望の動きになりますか？ (ROUGE)
一発で直りました。ありがとうございます。m(_ _)m m(_ _)m 信州
長～い夏休みが終わり、復帰しました。夏休みボケが抜けきっていませんが、宜しくお願いします。早速ですが、
With Worksheets("Sheet1")
tbl = .Range("A2", .Range("D" & Rows.Count).End(xlUp))
End With のtblは Variant型変数で、範囲はA２～D列の最後の行までを指しているのですね？ === 信州
そうです～。正確には、Sheet1のA2～D列の最後の行ですね＾＾ (ROUGE)
下記のCase"xx”のルーチンの意味がようわからへんので解説お願いします。4月度のデータ抽出と思いますが、
Case "4"
With dic4
ReDim tbl(1 To .Count, 1 To 4)
i = 0
For Each itm In .Items
i = i + 1
For j = 1 To 4
tbl(i, j) = itm(j - 1)
Next
Next
End With
①ReDim tbl(1 To .Count, 1 To 4) ②For Each itm In .Items ③For j = 1 To 4 ④tbl(i, j) = itm(j - 1) の意味がわからず、行き詰まっています。宜しくお願い申し上げます。 m(_ _)m m(_ _)m 信州
信州さん、配列とDictionaryオブジェクトを理解されないと難しいと思います。 一度ここを覗いてみてはいかがですか？ http://www6.plala.or.jp/MilkHouse/menu2.html (ROUGE)
有難うございます！紹介頂いたＨＰを猛勉させて頂きます！
それとは別に、itmという変数は何を指しているのか簡潔でいいですのでご教示お願いします！ == 信州
Dictionaryオブジェクトの.Itemsメソッドで得られた配列の中を、For Eachステートメント でループさせるための変数です。 (ROUGE)
信州さん、お尋ねします。 rougeさん、Seiyaさんが記述して下さったVBScript手法のDictionaryオブジェクトの概念は理解出来ましたか？ 私、さっぱりです。もし、理解できたのなら簡単なｻﾝﾌﾟﾙでもいいので教えて頂けません？ m(_ _)m 伊那
ROUGEさんが上で紹介してくださっているサイトの 【Dictionaryオブジェクト】 http://www6.plala.or.jp/MilkHouse/practical/contents307/contents30701.html ココが参考になると思いますよ＾＾ （キリキ）(〃⌒o⌒)b
キリキさん、ありがとうございます！早速お勉強します。 ☆伊那★
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.