いつもお世話になります、MEGUMIと申します。
既存のマクロに更に条件を追加したいという質問をさせてください。
現在、フォルダの中にある全てのエクセルファイルを下記のような処理をしています。
●エクセルファイルの中の全てのSheetの1行目以降のA,B,C,G,H列をコピーしてマクロを動作させるエクセルファイルのSheet1に順次(A,B,C,D,E列)ペースト
※マクロは下記の内容( Sub 今日のわたし()以降です )です。
これに下記のような条件を追加したいのですがどのようにすればいいでしょうか?
○I列に”元気”という文字が存在していた場合に限って、その列のA,B,C,G,H,I列をコピーしてマクロを動作させるエクセルファイルのSheet1に順次(A,B,C,D,E,F列)ペースト
お忙しいところ大変恐れ入りますがもしご存知の方がいらっしゃりましたらご指導のほど何卒宜しくお願いいたします。
Sub 今日のわたし()
Dim XlFile As String
Dim MotoDataLastRow As Long
Dim CopySakiLastRow As Long
ThisWorkbook.Activate
Worksheets(1).Select
Cells.Clear
XlFile = Dir(ThisWorkbook.Path & "\*.xls?")
Do While XlFile <> ""
If XlFile <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & XlFile, ReadOnly:=True
Worksheets(1).Select
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).[A65536:H65536].End(xlUp).Row '元データファイルの最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).[A65536:E65536].End(xlUp).Row 'インポート先の最終行を取得
If MotoDataLastRow > 1 Then
Range([A2], Cells(MotoDataLastRow, "C")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "A")
Range([G2], Cells(MotoDataLastRow, "H")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "D")
End If
Workbooks(XlFile).Close False
End If
XlFile = Dir()
Loop
End Sub
No.4ベストアンサー
- 回答日時:
ANo2-3 merlionXXです。
どうもよくわかりません。
> ”元気”という文字のある列のA,B,C,G,H,IをコピーしてA,B,C,D,E,F列にコピーで問題ないです。
”元気”という文字のある列はI列ですよね?
そのI列になぜA,B,C,G,H列があるんですか?I列にはI列しかないでしょう?
”元気”という文字のある行のA,B,C,G,H,I列をコピーするんじゃないのですか?
> 現在の問題は
> ”元気”という文字がI列に入っていなくて別の文字が入っていてもコピーしてきてしまいます。
これはANo.2で回答したコードでの結果ではないのですか?
ANo3のコード、Sub 今日のわたし03() では、”元気”という文字のある行だけ、A,B,C,G,H,I列をコピーするようにしたはずなのですが。
ひょっとしてエクセルのバージョンが違うとオートフィルタのコピーがうまくいかないのかもしれません。
可視セル("元気"フィルターで抽出されたセル)だけコピーするように変えてみました。
これでどうでしょう?
Sub 今日のわたし04()
Dim XlFile As String
Dim MotoDataLastRow As Long
Dim CopySakiLastRow As Long
Dim myC As Range
ThisWorkbook.Activate
Worksheets(1).Select
Cells.Clear
Application.ScreenUpdating = False
XlFile = Dir(ThisWorkbook.Path & "\*.xls?")
Do While XlFile <> ""
If XlFile <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & XlFile, ReadOnly:=True
With Worksheets(1)
Set myC = .Columns("I:I").Find(What:="元気", LookAt:=xlPart)
If Not myC Is Nothing Then
.AutoFilterMode = False
.Range("I:I").AutoFilter field:=1, Criteria1:="=*元気*"
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row '元データファイルのA列最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row 'インポート先のA列最終行を取得
.Range("A2", Cells(MotoDataLastRow, "C")).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "A")
.Range("G2", Cells(MotoDataLastRow, "I")).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "D")
End If
End With
Workbooks(XlFile).Close False
End If
XlFile = Dir()
Loop
Application.ScreenUpdating = True
End Sub
No.3
- 回答日時:
ANo2 merlionXXです。
違っているということは
、
> その列のA,B,C,G,H,I列をコピーして
ではなく、その行のA,B,C,G,H,I列をコピーするんですね?
ならば、これでいかがでしょう?
Sub 今日のわたし03()
Dim XlFile As String
Dim MotoDataLastRow As Long
Dim CopySakiLastRow As Long
Dim myC As Range
ThisWorkbook.Activate
Worksheets(1).Select
Cells.Clear
Application.ScreenUpdating = False
XlFile = Dir(ThisWorkbook.Path & "\*.xls?")
Do While XlFile <> ""
If XlFile <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & XlFile, ReadOnly:=True
With Worksheets(1)
Set myC = .Columns("I:I").Find(What:="元気", LookAt:=xlPart)
If Not myC Is Nothing Then
.AutoFilterMode = False
.Range("I:I").AutoFilter field:=1, Criteria1:="=*元気*"
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row '元データファイルのA列最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row 'インポート先のA列最終行を取得
If MotoDataLastRow > 1 Then
.Range("A2", Cells(MotoDataLastRow, "C")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "A")
.Range("G2", Cells(MotoDataLastRow, "I")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "D")
End If
End If
End With
Workbooks(XlFile).Close False
End If
XlFile = Dir()
Loop
Application.ScreenUpdating = True
End Sub
この回答への補足
申し訳ありません、私の説明不足でした。
”元気”という文字のある列のA,B,C,G,H,IをコピーしてA,B,C,D,E,F列にコピーで問題ないです。
現在の問題は
”元気”という文字がI列に入っていなくて別の文字が入っていてもコピーしてきてしまいます。
ちなみにI列に何も記載されていないとコピーはしてきません。
したいことは、
”元気”という文字がI列にあった場合にだけ、その列(”元気”がある列)のA,B,C,G,H,IをコピーしてA,B,C,D,E,F列にコピーしてきて欲しいのです。
取り急ぎではありますが以上何卒宜しくお願いいたします。
No.2
- 回答日時:
>.[A65536:H65536].End(xlUp).Row
このような書き方をはじめて見ましたが、どの列の最終行をもとめたいのでしょうか?
とりあえずA列で見ることにしました。
> ○I列に”元気”という文字が存在していた場合に限って、その列のA,B,C,G,H,I列をコピーしてマクロを動作させるエクセルファイルのSheet1に順次(A,B,C,D,E,F列)ペースト
元気という文字が存在しなければ何もしなくていいんですね?
では、一例です。
Sub 今日のわたし02()
Dim XlFile As String
Dim MotoDataLastRow As Long
Dim CopySakiLastRow As Long
Dim myC As Range
ThisWorkbook.Activate
Worksheets(1).Select
Cells.Clear
Application.ScreenUpdating = False
XlFile = Dir(ThisWorkbook.Path & "\*.xls?")
Do While XlFile <> ""
If XlFile <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & XlFile, ReadOnly:=True
With Worksheets(1)
Set myC = .Columns("I:I").Find(What:="元気", LookAt:=xlPart)
If Not myC Is Nothing Then
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row '元データファイルのA列最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row 'インポート先のA列最終行を取得
If MotoDataLastRow > 1 Then
.Range("A2", Cells(MotoDataLastRow, "C")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "A")
.Range("G2", Cells(MotoDataLastRow, "I")).Copy ThisWorkbook.Worksheets(1).Cells(CopySakiLastRow + 1, "D")
End If
End If
End With
Workbooks(XlFile).Close False
End If
XlFile = Dir()
Loop
Application.ScreenUpdating = True
End Sub
この回答への補足
早速の返信ありがとうございました。
なぜか”元気”以外の文字が有るところも拾ってきてペーストされてしまうようです。
私の質問にもっとも近い出来なので何とか”元気”以外の文字を拾ってペーストしないようにしたいのですが・・・
No.1
- 回答日時:
例えば。
変更前:
Worksheets(1).Select
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).[A65536:H65536].End(xlUp).Row '元データファイルの最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).[A65536:E65536].End(xlUp).Row 'インポート先の最終行を取得
変更後:
Worksheets(1).Select
activesheet.autofiltermode = false
range("I:I").autofilter field:=1, criteria1:="=*元気*"
MotoDataLastRow = Workbooks(XlFile).Worksheets(1).range("A65536").End(xlUp).Row '元データファイルの最終行を取得
CopySakiLastRow = ThisWorkbook.Worksheets(1).range("A65536").End(xlUp).Row 'インポート先の最終行を取得
のように。
#参考
今回ご質問内容には直接関係無い部分ですが,range("A65536:H65536").end(xlup)では「左端A列の」最下端しか調べることが出来ません。結果して上述「変更後」と同じ動作しかしていないという事です。
もしも最下端が「A列とは限らない」場合は,別の調べ方をする必要があります。
たとえばシート.cells.specialcells(xlcelltypelastcell)を調査するとか,BCDEFGH列を1列ずつ最下端を調べて一番大きい数字を採用するとか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
シート保護の状態で行の追加を...
-
EXCELにて複数列を同条件(色)...
-
エクセルで行挿入した際、自動...
-
エクセルVBA 複数列をコピーす...
-
エクセルで空白以外のセルの値...
-
エクセル マクロ 貼り付け先が...
-
特定の桁数を抽出
-
エクセルVBA 並び替え セルの...
-
Excelの非表示列も含めてコピー
-
エクセルの関数について(日付で...
-
エクセル VBA 指定の範囲内をコ...
-
Excel VBAで日にちを入力して線...
-
エクセルで表示された値だけ行...
-
一行おきにコピーするマクロが...
-
エクセルの複数のセルを一括で...
-
EXCELで○ヶ月を○年○ヶ月に変換...
-
A1セルに入力したら、入力時間...
-
Excelで同じセルに箇条書きをし...
-
Excelの入力規則で2列表示したい
-
リンク元の日付が空白の時リン...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCELにて複数列を同条件(色)...
-
一行おきにコピーするマクロが...
-
Excelの非表示列も含めてコピー
-
シート保護の状態で行の追加を...
-
エクセルの関数について(日付で...
-
エクセル マクロ 貼り付け先が...
-
エクセルで表示された値だけ行...
-
エクセルで行挿入した際、自動...
-
エクセル VBA 指定の範囲内をコ...
-
エクセルで空白以外のセルの値...
-
[Excel VBA]空白セル以外に連番...
-
【マクロ】IF複数条件の上限に...
-
行数が不規則な一週間ごとの合...
-
エクセルVBA 複数列をコピーす...
-
特定の桁数を抽出
-
エクセルで縦に長い表を印刷
-
最終行から上10行をコピーする...
-
Excel VBAで日にちを入力して線...
-
エクセルのマクロ、AVERAGEIFを...
-
マクロで値がある列までコピー
おすすめ情報