トップに関する質問 VBA オブジェクト（セレクトに格納した値）を別のブックに表示

編集履歴

質問編集履歴

2021/07/12 23:36

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -1,4 +1,4 @@
-**分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法****
+**分からない点はsheet2.Cells(row2, col2) = colect.item(i)  をコレクトの値をループさせて別のブックのセルに表示する方法****
 Const ST_ROW As Long=4
 Const ST_COL As Long=2
 Sub 数と日付()

2021/07/12 23:36

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -18,7 +18,8 @@
 Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set
   sheet1=Wb2.Worksheets("コピー元")
-Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
+Set sheet2=Wb1.Worksheets("コピー先")
+ lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
 If sheet1.Cells(row, 4) >= 2 Then
  For col=ST_COL To lastcol
  ary(index, index2) = sheet1.Cells(row, col)

2021/07/12 23:34

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:34

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:34

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -17,7 +17,8 @@
 Set Wb1=ThisWorkbook 'コピー先ブック
 Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set
-  sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
+  sheet1=Wb2.Worksheets("コピー元")
+Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
 If sheet1.Cells(row, 4) >= 2 Then
  For col=ST_COL To lastcol
  ary(index, index2) = sheet1.Cells(row, col)

2021/07/12 23:34

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -14,8 +14,10 @@
 Dim index As Long
 Dim index2 As Long
 Dim colect As Collection, item As Variant Set colect=New Collection sPath="Book11.xlsx"
-Set Wb1=ThisWorkbook 'コピー先ブック
-Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
+Set Wb1=ThisWorkbook 'コピー先ブック
+Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set
+  sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
 If sheet1.Cells(row, 4) >= 2 Then
  For col=ST_COL To lastcol
  ary(index, index2) = sheet1.Cells(row, col)

2021/07/12 23:34

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -15,7 +15,7 @@
 Dim index2 As Long
 Dim colect As Collection, item As Variant Set colect=New Collection sPath="Book11.xlsx"
 Set Wb1=ThisWorkbook 'コピー先ブック
-Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow '縦の最初と末尾
+Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
 If sheet1.Cells(row, 4) >= 2 Then
  For col=ST_COL To lastcol
  ary(index, index2) = sheet1.Cells(row, col)

2021/07/12 23:33

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -1,5 +1,4 @@
-** 分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法
+**分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法****
- **
 Const ST_ROW As Long=4
 Const ST_COL As Long=2
 Sub 数と日付()

2021/07/12 23:33

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:32

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:32

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -1,5 +1,5 @@
-分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法
+** 分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法
+ **
 Const ST_ROW As Long=4
 Const ST_COL As Long=2
 Sub 数と日付()

2021/07/12 23:32

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -1,4 +1,34 @@
 分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法
+Const ST_ROW As Long=4
+Const ST_COL As Long=2
+Sub 数と日付()
+Dim Wb1 As Workbook
+Dim Wb2 As Workbook
+Dim ary() As String
+Dim row As Long
+Dim col As Long
+Dim sheet1 As Worksheet
+Dim sheet2 As Worksheet
+Dim lastRow As Long
+Dim lastcol As Long
+Dim index As Long
+Dim index2 As Long
+Dim colect As Collection, item As Variant Set colect=New Collection sPath="Book11.xlsx"
+Set Wb1=ThisWorkbook 'コピー先ブック
+Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set sheet1=Wb2.Worksheets("コピー元") Set sheet2=Wb1.Worksheets("コピー先") lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow '縦の最初と末尾
+If sheet1.Cells(row, 4) >= 2 Then
+ For col=ST_COL To lastcol
+ ary(index, index2) = sheet1.Cells(row, col)
+index2=index2+1
+ Next colect.Add ary End If index2 = 0
+ Next Dim row2 As Long
+ Dim col2 As Long
+ Dim i As Long
-Const ST_ROW As Long = 4Const ST_COL As Long = 2Sub 数と日付()    Dim Wb1 As Workbook    Dim Wb2 As Workbook    Dim ary() As String    Dim row As Long    Dim col As Long    Dim sheet1 As Worksheet    Dim sheet2 As Worksheet    Dim lastRow As Long    Dim lastcol As Long    Dim index As Long    Dim index2 As Long    Dim colect As Collection, item As Variant    Set colect = New Collection        sPath = "Book11.xlsx"    Set Wb1 = ThisWorkbook 'コピー先ブック    Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック    Set sheet1 = Wb2.Worksheets("コピー元")    Set sheet2 = Wb1.Worksheets("コピー先")    lastRow = sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row    lastcol = sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column        ReDim ary(0, lastcol - ST_COL)    For row = ST_ROW To lastRow '縦の最初と末尾        If sheet1.Cells(row, 4) >= 2 Then  '2以上の時            For col = ST_COL To lastcol '横の最初と末                ary(index, index2) = sheet1.Cells(row, col) '価を格納する                index2 = index2 + 1 '次の横の価に            Next            colect.Add ary        End If    index2 = 0          '横の価をリセット    Next        Dim row2 As Long        Dim col2 As Long        Dim i As Long            For row2 = 2 To colect.Count                For col2 = 1 To 4                    sheet2.Cells(row2, col2) = colect.item(i)                    col2 = col2 + 1                Next                col2 = 0             Next        sheet2.Range("A1:D1").Value = sheet1.Range("B3:E3").Value        With ActiveSheet            .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes        End WithEnd Sub
+**ここから下が不明点**
+ For row2=2 To colect.Count
+ For col2=1 To 4 sheet2.Cells(row2,
+ col2)=colect.item(i)
+ col2=col2+1 Next col2=0 Next
+  sheet2.Range("A1:D1").Value=sheet1.Range("B3:E3").Value With ActiveSheet .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes End WithEnd Sub

2021/07/12 23:30

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

File without changes

2021/07/12 12:41

投稿

maxsbezitaburu

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -1,1 +1,4 @@
+分からない点はsheet2.Cells(row2, col2) = colect.item(i)  以降のコレクトの値をループさせてブックに表示する方法
 Const ST_ROW As Long = 4Const ST_COL As Long = 2Sub 数と日付()    Dim Wb1 As Workbook    Dim Wb2 As Workbook    Dim ary() As String    Dim row As Long    Dim col As Long    Dim sheet1 As Worksheet    Dim sheet2 As Worksheet    Dim lastRow As Long    Dim lastcol As Long    Dim index As Long    Dim index2 As Long    Dim colect As Collection, item As Variant    Set colect = New Collection        sPath = "Book11.xlsx"    Set Wb1 = ThisWorkbook 'コピー先ブック    Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック    Set sheet1 = Wb2.Worksheets("コピー元")    Set sheet2 = Wb1.Worksheets("コピー先")    lastRow = sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row    lastcol = sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column        ReDim ary(0, lastcol - ST_COL)    For row = ST_ROW To lastRow '縦の最初と末尾        If sheet1.Cells(row, 4) >= 2 Then  '2以上の時            For col = ST_COL To lastcol '横の最初と末                ary(index, index2) = sheet1.Cells(row, col) '価を格納する                index2 = index2 + 1 '次の横の価に            Next            colect.Add ary        End If    index2 = 0          '横の価をリセット    Next        Dim row2 As Long        Dim col2 As Long        Dim i As Long            For row2 = 2 To colect.Count                For col2 = 1 To 4                    sheet2.Cells(row2, col2) = colect.item(i)                    col2 = col2 + 1                Next                col2 = 0             Next        sheet2.Range("A1:D1").Value = sheet1.Range("B3:E3").Value        With ActiveSheet            .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes        End WithEnd Sub