Excel EXCELのVBAについて結合シートにまとめ

Excel EXCELのVBAについて結合シートにまとめ。変数の綴りりミスがあります。EXCELのVBAについて結合シートにまとめたいです

全シートが13あり、そのうち1~6のシートが対象です (シート名は〇月)
6シートのフォーマットは同じで、A2~Z2まで見出しで、データはA3~Zまであります
各シートによって最終行は変動します 1シート大体200行です
結合シートはA3~Dまであります

K?P?U列に文字列(みかん?りんご?等)が入力してあり、
K3から1行づつ見ていき、
①K3?(P3?U3は空白)に文字が入力されていたら、結合シートにK3?A3?M3?L3を転記する
②K3?P3(?U3は空白)に文字が入力されていたら、結合シートにP3?A3?R3?Q3を転記する
③K3?P3?U3に文字が入力されていたら、結合シートにU3?A3?W3?V3を転記する
これを最終行までループで回して結合シートにまとめたいです

作ったコードが以下の通りです

Sub marge()

Dim sh As Worksheet
Dim i, j, LastRow, shLastRow As Long

Application ScreenUpdating = False

Set sh = Worksheets("結合シート") & x27;
shLastrRow = sh Cells(Rows Count, 1) End(xlUp) Row

sh Range("A3:D" & shLastrRow) ClearContents

For i = 1 To 6
With Worksheets(i)
LastRow = Cells(Rows Count, 1) End(xlUp) Row
If Name <> sh Name Then
For j = 3 To LastRow

If Cells(j, "K") <> "" And Cells(j, "P") = "" And Cells(j, "U") = "" Then
sh Cells(shLastrRow, "A") = Cells(j, "K")
sh Cells(shLastrRow, "B") = Cells(j, "A")
sh Cells(shLastrRow, "C") = Cells(j, "M")
sh Cells(shLastrRow, "D") = Cells(j, "L")
ElseIf Cells(j, "K") <> "" And Cells(j, "P") <> "" And Cells(j, "U") = "" Then
sh Cells(shLastrRow, "A") = Cells(j, "P")
sh Cells(shLastrRow, "B") = Cells(j, "A")
sh Cells(shLastrRow, "C") = Cells(j, "R")
sh Cells(shLastrRow, "D") = Cells(j, "Q")
ElseIf Cells(j, "K") <> "" And Cells(j, "P") <> "" And Cells(j, "U") <> "" Then
sh Cells(shLastrRow, "A") = Cells(j, "U")
sh Cells(shLastrRow, "B") = Cells(j, "A")
sh Cells(shLastrRow, "C") = Cells(j, "W")
sh Cells(shLastrRow, "D") = Cells(j, "V")
End If
j = j + 1
Next j
End If
End With
i = i + 1
Next i

Application ScreenUpdating = True
End Sub

これを動かすと結合シートは何も変わらず空白のままです
どうしたらよいかご教授頂けますか
宜しくお願い致します Excelファイルに。ファイルを改造して。シートをつにするマクロを入れる手順をまとめてみ
ました。 マクロを知らなくても使えます複数のシートのデータをつにする
方法を身につけておきたいものです。 その方法は。マクロ

複数のシートのデータを1つのシートにまとめる:Excel。列方向へコピーしてまとめたい? へ 上記は「全データ」シートへ行方向へ
コピーしましたが。列方向へコピーする例です。Excel。で複数のファイルにあるデータを。つのファイルにまとめる方法についてご
説明します。例えば同じフォルダ内意外と手動で。ミスなく確実につの
ファイルに結合するのは「難しい作業」です。 同じデータを結合しいまさら聞けない。それなら。動画学習がおすすめです。 いまさら聞けない。?シートを
たった数秒でまとめる方法をご紹介。 巻末にダウンロードファイルもある
よ! ※複数のシートのデータを1つのシートにコピーする:Excel。この処理を「」シートを除くすべてのシートについて行い。最後に「
」シートを列でソートします。 &#;
データシートコピー元 &#;集約用シートコピー先

変数の綴りりミスがあります。まず、Option?Explicitを入れるべきです。Dim?i,?j,?LastRow,?shLastRow?As?Longこの書き方だと、shLastRow?たけLongになります。面倒でもDim?は分けた方がいいです。shLastRow?=?sh.CellsRows.Count,?1.EndxlUp.Row?+?1消去前にやっているので、前のデータの最後になります。shLastRow?=?3にすべきです。j?=?j?+?1,?i?=?i?+?1For?は自動カウントアップなので不要です。その一方で、shLastRowをカウントアップしていないので、出力先はいつも同じになります。'Sub?Macro1'????Dim?Sheet?As?Integer????Dim?Row?As?Long????Dim?RowOut?As?Long????Dim?Col?As?String????Dim?ColOut?As?Integer????Dim?K?As?String????Dim?P?As?String????Dim?U?As?String????Dim?OutTable?As?String'????Sheets結合シート.Select????RowOut?=?3????Application.ScreenUpdating?=?False????[A3:D1048576].ClearContents'????For?Sheet?=?1?To?6????????With?SheetsSheet'????????For?Row?=?3?To?.CellsRows.Count,?A.EndxlUp.Row????????????K?=?.CellsRow,?K????????????P?=?.CellsRow,?P????????????U?=?.CellsRow,?U????????????????????????If?K???And?P?=??And?U?=??Then????????????????OutTable?=?K?A?M?L?????????????ElseIf?K???And?P???And?U?=??Then????????????????OutTable?=?P?A?R?Q?????????????ElseIf?K???And?P???And?U???Then????????????????OutTable?=?U?A?W?V?????????????Else????????????????OutTable?=?????????????End?If'????????????For?ColOut?=?1?To?LenOutTable?Step?2????????????????Col?=?MidOutTable,?ColOut,?2????????????????Col?=?RTrimCol????????????????CellsRowOut,?ColOut?/?2?+?1?=?.CellsRow,?Col????????????Next?ColOut????????????RowOut?=?RowOut?-?OutTable??????????Next?Row????????End?With????Next?SheetEnd?Sub’私のサンプルです。AA以降もできるようにするため、OutTableは2文字にしました。条件が①②③以外が存在しないのであれば”K3?U3?P3は空白に文字が入力されていたら”が存在しないのならば取り出すデータはK列にデータが有る場合A列とK,P,U列にデータが存在すればU,V,W列A列を基準として20,21,22列目K,P列にのみデータが存在すればP,Q,R列A列を基準として15,16,17列目K列にのみデータが存在すればK,L,M列A列を基準として10,11,12列目順番の入れ替えが必要Sub testDim sh As Worksheet, shLastrRow As Long, Buf As Integer, i As IntegerDim CRange As Range, TRange As RangeSet sh = Worksheets結合シート'結合シートのデータ書き出しセルSet CRange = sh.RangeA3shLastrRow = sh.CellsRows.Count, 1.EndxlUp.Rowsh.RangeCRange, DshLastrRow.ClearContentsFor i = 1 To 6With Worksheetsi'読み込みシートのデータ読み込み行のA列Set TRange = .RangeA3Do'K列にデータが有る場合If TRange.Offset, 10 Then'P列にデータがあればBufは15、U列にデータがあればBufは20になるBuf = 10 – TRange.Offset, 15 * 5 + TRange.Offset, 20 * 5'データの転記CRange = TRange.Offset, BufCRange.Offset, 1 = TRangeCRange.Offset, 2 = TRange.Offset, Buf + 2CRange.Offset, 3 = TRange.Offset, Buf + 1'データ書き出しセルの移動Set CRange = CRange.Offset1End If'読み込み行の移動Set TRange = TRange.Offset1'読み込み行のA列が空欄になるまでループLoop While TRangeEnd WithNextEnd Subこんな感じに転記処理はデータの状況によって読み込みセルを変えることで一つにまとめることが出来ます

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です