0 ThenRange("AI4").CopyCells(i5, "AI"...">マクロについて データ整理用で使った構文 | メモブロ-ゲームとガンダムの部屋-
FC2ブログ

マクロについて データ整理用で使った構文


■テストというエクセルファイルのテストというマクロを動作させる。
Application.Run "テスト.xlsm" & "!テスト"

■i6セル~iの最下行をチェックし、0以上の値であれば、AI4の値をAIの0でないと判断された行にコピーするマクロ
使い方はある行の値が空白でないとき、ある行に値をコピーしたい時とか

Dim i5 As Long
For i5 = 6 To Cells(Rows.Count, "I").End(xlUp).Row
If Cells(i5, "I").Value > 0 Then
Range("AI4").Copy
Cells(i5, "AI").Select
ActiveSheet.Paste
End If
Next

■AJ4セルをテストという名前のシートのC7に値のみコピー
Range("AJ4").Select
Selection.Copy
Sheets("テスト").Select
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

■テストというシートのA~V列の8行目以降で値が入力されているセルを塗りつぶしも含めて消去

Sheets("テスト").Select
Range("A8:V8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

■C5セルに入力していエクセルを開く(C5にはパスも入力しておくこと)
Workbooks.Open Filename:=Range("C5").Value

■テスト1のエクセルにある表(先頭をB5セルとする)をテスト2のマクロ処理用というシートのB5セルにコピー
※エクセルの名前は拡張子も含めて記入すること
Workbooks("テスト1").Activate
Range("B5").Select 'コピーを実行
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("テスト2").Activate '貼り付けを実行
Sheets("マクロ処理用").Select
Range("B5").Select
ActiveSheet.Paste

■テストというシートで塗りつぶしのある行を塗りつぶしなしに変更
※B列を参照し空白でない箇所を塗りつぶしなしにしている。
Sheets("テスト").Select
Dim nurinasi As Long
For nurinasi = 6 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(nurinasi, "F").Value <> "" Then
Rows(nurinasi).Interior.Color = xlNone
End If
Next
■A7から始まる表にて、入力されている数式等をすべて値に変換するマクロ
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollRow = 518
ActiveWindow.ScrollRow = 517
ActiveWindow.ScrollRow = 511
ActiveWindow.ScrollRow = 491
ActiveWindow.ScrollRow = 466
ActiveWindow.ScrollRow = 417
ActiveWindow.ScrollRow = 355
ActiveWindow.ScrollRow = 301
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 101
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 1
ActiveWindow.LargeScroll ToRight:=-1
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

■テスト1のシートをコピーして名前(テスト2)を付ける
Sheets("テスト1").Select
Sheets("テスト1").Copy after:=Sheets(2)
Sheets("テスト1 (2)").Select
Sheets("テスト1 (2)").Name = "テスト2"

■特定の文字を含むデータを行ごとコピーするマクロ
今回はシート・テスト1のB8以降(B9,B10・・・)の行にA21という文字を含んでいた場合、
その行をシート・テスト2の8行目以降にコピーという動作
Sheets("テスト1").Select
Dim i As Long
Dim j As Long
j = 8
For i = 8 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value = "A21" Then
Rows(i).Copy
Sheets("テスト2").Rows(j).PasteSpecial Paste:=xlPasteValues
j = j + 1
End If
Next

■シート・テストのB759行目が空欄でないとき、A760~A1008の値を消去するマクロ
Sheets("テスト").Select
If Range("B759").Value <> "" Then
Range("A760:A1008").ClearContents
End If

■M100~O100セルに入力されている式を値に変換
Range("M100:O100").Select
Application.CutCopyMode = False
Selection.Copy
Range("M100").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

■U~V列を削除
Columns("U:V").Delete

■B759セルが空欄の時、1009行目を削除するマクロ
If Range("B759").Value = "" Then
Rows(1009).Delete
End If

■B759~B1008で空白があれば空白行を詰めるマクロ
※空白がない場合、エラーがでます
Range("B759:B1008").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

※エラーで止まらないようにする場合
On Error Resume Next
Range("B759:B1008").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

■A3を値にする
Range("A3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

■現在のアクティブシートを別のワークブックとして保存するマクロ。
ここでアクティブシートはシート・テストのあるマクロと同じワークブックである必要がある。
シート・テストと同じフォルダにシート・テストのM47に入力されているファイル名を付け、シート名をC1セルに入力されている値に変更

Dim i As Variant
Dim j As String
i = Sheets("テスト").Range("M47").Value
j = ThisWorkbook.Path
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=j & "\" & i & ".xlsx"
Worksheets(1).Name = Workbooks("テスト..xlsm").Sheets("テスト").Range("C1").Value
ActiveWorkbook.Close SaveChanges:=True
End If

■シート・テストを削除するマクロ
Sheets("テスト").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

■A1に値をを入力するマクロ(ここではAAAと入力)
Range("A1").Select
ActiveCell.FormulaR1C1 = "AAA"

■6行目より下の行高さを18に変更するマクロ
Rows("6:6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RowHeight = 18

■B~AE列の6行目以降の文字の中央揃え
Range("B6:AE6").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

■B~AE列の6行目以降のセルの設定を、縮小して全体を表示に変更
Range("B6:AE6").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With





























 0

COMMENTS

マクロについて