前提・実現したいこと
VBAを使用し、下記のような入力がしたいです
①.txtファイルを選択し、指定の48個のデータを抽出
↑ここまではできています
②48個のデータ内の最初の6個を、作業者が選択したセルから縦に入力
③縦に4つ飛ばし、次の6個を縦に入力
④最初に選択したセルから右に4行飛ばし、次の6個を入力
⑤また縦に4つ飛ばし、次の6個を入力
このループを4回分
また、今回は48個・6個ずつ・4つ飛ばしとしていますが、
今後は56個・7個ずつ・3つ飛ばしなどの入力もありますので、
8の倍数に対応した方法も教えていただけると幸いです
分かりにくい内容で申し訳有りませんが、ご教授よろしくお願い致します
発生している問題・エラーメッセージ
該当のソースコード
Sub 入力()
Dim NUMB As Variant
Dim 配列(9999) As Double
Dim i As Integer
Dim POG As Variant
Dim k As Integer
Dim strFileName As String
Dim strFilePath As String
Dim a As Long
strFilePath = "ファイルの場所" strFileName = X(strFilePath) Workbooks.OpenText Filename:= _ strFilePath & strFileName, Origin:=932, _ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _ , Space:=False, Other:=False, fieldinfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _ Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _ 16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _ Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _ 29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _ Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1)), _ TrailingMinusNumbers:=True Dim j As Long, l As Long l = 1 For j = 2 To 1000 l = l + 1 If InStr(Cells(j, 4), "指定の文字列") = 0 Then Exit For End If Next For i = 1 To l 入力(i) = Range("J" & i + 1).Value Next Workbooks(1).Worksheets("Sheet1").Activate Set POG = Application.InputBox(prompt:="入力開始するセルをクリック", _ Default:=ActiveCell.Address, Type:=8) l = l - 2 a = l / 8 For i = 1 To a k = i - 1 POG.Offset(k, 0).Value = Round(入力(i)) Next For i = a + 1 To a * 2 k = i - 7 POG.Offset(10 + k, 0).Value = Round(入力(i)) Next For i = (a * 2) + 1 To a * 3 k = i - 13 POG.Offset(k, 4).Value = Round(入力(i)) Next For i = (a * 3) + 1 To a * 4 k = i - 19 POG.Offset(10 + k, 4).Value = Round(入力(i)) Next For i = (a * 4) + 1 To a * 5 k = i - 25 POG.Offset(k, 8).Value = Round(入力(i)) Next For i = (a * 5) + 1 To a * 6 k = i - 31 POG.Offset(10 + k, 8).Value = Round(入力(i)) Next For i = (a * 6) + 1 To a * 7 k = i - 37 POG.Offset(k, 12).Value = Round(入力(i)) Next For i = (a * 7) + 1 To a * 8 k = i - 43 POG.Offset(10 + k, 12).Value = Round(入力(i)) Next Workbooks(strFileName).Close True Exit Sub
試したこと
あまりにもコードが冗長になってしまったので
きれいで分かりやすい書き方を教えていただけるとありがたいです
補足情報(FW/ツールのバージョンなど)
Excel 2016 Win10 です
回答2件
あなたの回答
tips
プレビュー