質問するログイン新規登録

質問編集履歴

2

2018/11/06 03:15

投稿

kazu9n
kazu9n

スコア13

title CHANGED
File without changes
body CHANGED
@@ -97,4 +97,7 @@
97
97
  入力画面というエクセルのワークシートから取り出したいです。
98
98
  リストボックスの項目数は11項目(金額、メーカー等)有ります。
99
99
  A1:A11といった形で抽出したいです。
100
- このコード自体が問題なのか、それ以外が問題なのかわかりません。
100
+ このコード自体が問題なのか、それ以外が問題なのかわかりません。
101
+
102
+ 追記
103
+ 自分で探した方が簡単そうなので自分でやりますね

1

変更しました

2018/11/06 03:15

投稿

kazu9n
kazu9n

スコア13

title CHANGED
File without changes
body CHANGED
@@ -10,21 +10,91 @@
10
10
  ### 該当のソースコード
11
11
 
12
12
  ```
13
+ Private Sub ok_Click()
14
+ Dim lastRow As Long
15
+ Dim myData, myData2(), myno
16
+ Dim i As Long, cn As Long
17
+ With Worksheets("入力画面")
18
+ lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
19
+ myData = .Range(.Cells(1, 1), .Cells(lastRow, 11)).Value
20
+ End With
21
+ ReDim myData2(1 To lastRow, 1 To 11)
22
+ For i = LBound(myData) To UBound(myData)
23
+ If myData(i, 1) Like "*" & date1.Value & "*" And myData(i, 2) Like "*" & den.Value & "*" _
24
+ Then
25
+ cn = cn + 1
26
+ myData2(cn, 1) = myData(i, 1)
27
+ myData2(cn, 2) = myData(i, 2)
28
+ myData2(cn, 3) = myData(i, 3)
29
+ myData2(cn, 4) = myData(i, 4)
30
+ myData2(cn, 5) = myData(i, 5)
31
+ myData2(cn, 6) = myData(i, 6)
32
+ myData2(cn, 7) = myData(i, 7)
33
+ myData2(cn, 8) = myData(i, 8)
34
+ myData2(cn, 9) = myData(i, 9)
35
+ myData2(cn, 10) = myData(i, 10)
36
+ myData2(cn, 11) = myData(i, 11)
37
+ End If
38
+ Next i
39
+ With ListBox1
40
+ .ColumnCount = 11
41
+ .ColumnWidths = "30;30;30;30;30;30;30;30;30;30;30"
42
+ .List = myData2
43
+ End With
44
+
45
+ End Sub
46
+
13
47
  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
14
48
  Dim r1 As Variant
15
49
  Dim r2 As Variant
16
50
  With Worksheets("入力画面")
17
- Debug.Print r1 = .Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 11))
51
+ r1 = .Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 11))
18
- Debug.Print r2 = WorksheetFunction.Transpose(WorksheetFunction.Transpose(r1))
52
+ r2 = WorksheetFunction.Transpose(WorksheetFunction.Transpose(r1))
19
- Debug.Print MsgBox(Join(r2, ""))
53
+ MsgBox Join(r2, "")
20
-
21
54
  End With
22
55
  End Sub
23
56
 
57
+
58
+ Private Sub UserForm_Initialize()
59
+ Dim lastRow As Long
60
+ Dim myData10, myData12()
61
+ Dim i As Long
62
+ Dim cn As Long
63
+
64
+
65
+ With Worksheets("入力画面")
66
+ lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
67
+ myData10 = .Range(.Cells(1, 1), .Cells(1, 11)).Value
68
+ End With
69
+
70
+ ReDim myData12(1 To lastRow, 1 To 11)
71
+ For i = LBound(myData10) To UBound(myData10)
72
+ cn = 1
73
+ myData12(cn, 1) = myData10(i, 1)
74
+ myData12(cn, 2) = myData10(i, 2)
75
+ myData12(cn, 3) = myData10(i, 3)
76
+ myData12(cn, 4) = myData10(i, 4)
77
+ myData12(cn, 5) = myData10(i, 5)
78
+ myData12(cn, 6) = myData10(i, 6)
79
+ myData12(cn, 7) = myData10(i, 7)
80
+ myData12(cn, 8) = myData10(i, 8)
81
+ myData12(cn, 9) = myData10(i, 9)
82
+ myData12(cn, 10) = myData10(i, 10)
83
+ myData12(cn, 11) = myData10(i, 11)
84
+ Next i
85
+
86
+ With ListBox1
87
+ .ColumnCount = 11
88
+ .ColumnWidths = "30;30;30;30;30;30;30;30;30;30;30"
89
+ .List = myData12
90
+ End With
91
+ End Sub
92
+
24
93
  ```
25
94
 
26
95
  ### 補足情報
27
96
 
28
97
  入力画面というエクセルのワークシートから取り出したいです。
29
- リストボックスの項目数は11項目有ります。
98
+ リストボックスの項目数は11項目(金額、メーカー等)有ります。
99
+ A1:A11といった形で抽出したいです。
30
100
  このコード自体が問題なのか、それ以外が問題なのかわかりません。