| |
Sheet1のデータを、二次元配列に取り込みそれをSheet5のシートの列
に代入したいのですが、やり方がわからずこまっています。
わかる方いらしたら教えてくださいよろしくお願いします。
Shhet1内容
B2からF22まで題目がありますG2〜2最終列まで日にち B3からF51まで製品内容
C3からFE51まで予定数のクロス集計表
Sheet5
Sheet1の内容をデータベースシートにしたいです。
途中までのプログラム
Option Base 1
Sub テーブルに変換()
Dim Myval2() '配列Myval2宣言
Dim Myval
Dim tmp
Dim i As Long 'Long型 ｉを宣言
Dim K As Long 'Long型 Kを宣言
Dim m As Long
Dim s As Long
Dim Sh1 As Worksheet
Dim Sh5 As Worksheet
Dim Myval3()
Set Sh1 = Worksheets("Sheet1")
Set Sh5 = Worksheets("Sheet5")
Sh1.Activate
Range("A1").Select
Myval = Sh1.Range("B2").Resize _
(Range("B65536").End(xlUp).Row, Range("xfc2").End(xlToLeft).Column)
ReDim Preserve Myval2(UBound(Myval, 1), UBound(Myval, 2))
For i = 1 To UBound(Myval, 1)
For K = 6 To UBound(Myval, 2)
Myval2(i, K) = Myval(i, 1) & "_" & Myval(i, 2) & "_" & Myval(i, 3) _
& "_" & Myval(i, 4) & "_" & Myval(i, 5) _
& "_" & Myval(1, K) & "_" & Myval(i, K)
Next
Next
Sh5.Activate
Sh5.Cells(1, 1).Select
’ここでSheet5へ転記したいのですが、やり方がわかりません
Columns("A:A").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$A$10000").AutoFilter Field:=1, Criteria1:="<>"
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
For m = 2 To Range("A65536").End(xlUp).Row
tmp = Split(Cells(m, 1), "_")
Cells(m, 2) = tmp(0)
Cells(m, 3) = tmp(1)
Cells(m, 4) = tmp(2)
Cells(m, 5) = tmp(3)
Cells(m, 6) = tmp(4)
Cells(m, 7) = tmp(5)
Cells(m, 8) = tmp(6)
Next
Range("A:A").Select
Selection.Delete
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
