B列以降に”1”が入っていればその上の1行目の値をA列に返す
2行目の”1”を見てA列に”C”を返す
3行目の"1"を見てA列に”D”・・・4行目・・・”A”を・・
=IF(COUNT(B2:F2)=1,INDEX($B$1:$F$1,MATCH(1,B2:F2,0)),"")
2018年3月16日金曜日
【関数】見出しを返す
✦表の見出し(項目)を返す。
B列以降に”1”が入っていればその上の1行目の値をA列に返す
2行目の”1”を見てA列に”C”を返す
3行目の"1"を見てA列に”D”・・・4行目・・・”A”を・・
=IF(COUNT(B2:F2)=1,INDEX($B$1:$F$1,MATCH(1,B2:F2,0)),"")
B列以降に”1”が入っていればその上の1行目の値をA列に返す
2行目の”1”を見てA列に”C”を返す
3行目の"1"を見てA列に”D”・・・4行目・・・”A”を・・
=IF(COUNT(B2:F2)=1,INDEX($B$1:$F$1,MATCH(1,B2:F2,0)),"")
【関数】TRIM
✦ハイフンで区切られている特定の部分を抜く
11-22-33-44-55-66-77-88-99-01
=TRIM(MID(SUBSTITUTE($B3,"-",REPT(" ",100)),5*100-99,100))
この場合は5個目の55が返る
=TRIM(MID(SUBSTITUTE($B3,"-",REPT(" ",100)),10*100-99,100))
この場合は10個目の01が返る
=RIGHT(A2,LEN(A2)-FIND(" ",SUBSTITUTE(A2,"-"," ",3)))
↑3個目の-から右側の文字を抜く 44-55-66-77-88-99-01が返る
=RIGHT(A2,LEN(A2)-FIND(" ",SUBSTITUTE(A2,"-"," ",4)))
↑4個目の-から右側の文字を抜く 55-66-77-88-99-01が返る
=TRIM(RIGHT(SUBSTITUTE(A1,"-",REPT(" ",50)),50))
右の最後のハイフンより右側の文字を抜く 01が返る
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
11-22-33-44-55-66-77-88-99-01
=TRIM(MID(SUBSTITUTE($B3,"-",REPT(" ",100)),5*100-99,100))
この場合は5個目の55が返る
=TRIM(MID(SUBSTITUTE($B3,"-",REPT(" ",100)),10*100-99,100))
この場合は10個目の01が返る
=RIGHT(A2,LEN(A2)-FIND(" ",SUBSTITUTE(A2,"-"," ",3)))
↑3個目の-から右側の文字を抜く 44-55-66-77-88-99-01が返る
=RIGHT(A2,LEN(A2)-FIND(" ",SUBSTITUTE(A2,"-"," ",4)))
↑4個目の-から右側の文字を抜く 55-66-77-88-99-01が返る
=TRIM(RIGHT(SUBSTITUTE(A1,"-",REPT(" ",50)),50))
右の最後のハイフンより右側の文字を抜く 01が返る
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
【マクロ】色が付いたセル以外の値を消す。
✦色が付いたセル以外の値を消す。
残したいセルを色を付けてマーキングし、それ以外を消す。
For i = 2 To 15
For j = 1 To 7
If Cells(i, j).Interior.ColorIndex = xlNone Then
Cells(i, j).ClearContents
'Else
End If
Next
Next
残したいセルを色を付けてマーキングし、それ以外を消す。
For i = 2 To 15
For j = 1 To 7
If Cells(i, j).Interior.ColorIndex = xlNone Then
Cells(i, j).ClearContents
'Else
End If
Next
Next
2018年3月15日木曜日
【マクロ】範囲選択
✦A2から15列目(O列)までを選択する。
しかし、この場合は15列目に空白セルがあるとそこまでの範囲となる。
例えばA100行まで値が有りO列は50行までしか値がない場合、
A50:O50の範囲選択となる。
Range("A2", Cells(Rows.Count, 15).End(xlUp)).Select
上記を回避する方法がこれだ。
途中にブランクがある表の最終セルまで選択する。
Range("A2:O" & Cells(Rows.Count, 1).End(xlUp).Row).Select
表の最後まで空白もなく値が入っている箇所をCells(Rows.Count, 1)で
指定する(この場合はA列)。選択したい範囲をRange("A2:O" とすれば
A100：O100までの範囲を選択できる。
------------------------------------------------------------------------------
✦A列の最終セルからオフセットする。
D列でA列の最終セルから下へひとつ下がったセル。
A15まで値が入っている場合、D16を選択する。
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("D" & r).Select
------------------------------------------------------------------------------
✦セルに数式が入っている場合の選択する。
通常では数式が入っているセルを全て選択する。
例えば下記のようにすると、数式が入っているセルを全て選択してしまう。
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Select
それを回避するのがこれだ。
数式が入り値が返っている範囲だけを選択する。
数式が入っていても空白セルは選択しない。
Dim i As Long
On Error Resume Next
For i = Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
If Cells(i, "C") <> "" Then Exit For
Next i
Cells(i, "C").Offset(0).Select
これはかなり使えるね。
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
しかし、この場合は15列目に空白セルがあるとそこまでの範囲となる。
例えばA100行まで値が有りO列は50行までしか値がない場合、
A50:O50の範囲選択となる。
Range("A2", Cells(Rows.Count, 15).End(xlUp)).Select
上記を回避する方法がこれだ。
途中にブランクがある表の最終セルまで選択する。
Range("A2:O" & Cells(Rows.Count, 1).End(xlUp).Row).Select
表の最後まで空白もなく値が入っている箇所をCells(Rows.Count, 1)で
指定する(この場合はA列)。選択したい範囲をRange("A2:O" とすれば
A100：O100までの範囲を選択できる。
------------------------------------------------------------------------------
✦A列の最終セルからオフセットする。
D列でA列の最終セルから下へひとつ下がったセル。
A15まで値が入っている場合、D16を選択する。
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("D" & r).Select
------------------------------------------------------------------------------
✦セルに数式が入っている場合の選択する。
通常では数式が入っているセルを全て選択する。
例えば下記のようにすると、数式が入っているセルを全て選択してしまう。
Range("C2", Cells(Rows.Count, 3).End(xlUp)).Select
それを回避するのがこれだ。
数式が入り値が返っている範囲だけを選択する。
数式が入っていても空白セルは選択しない。
Dim i As Long
On Error Resume Next
For i = Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
If Cells(i, "C") <> "" Then Exit For
Next i
Cells(i, "C").Offset(0).Select
これはかなり使えるね。
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
【マクロ】オートフィルター
✦集計シートの値でテーブル1をフィルターかける。
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("集計")
Set sh2 = Sheets("テーブル1")
If sh1.Range("A1") <> "" Then
sh2.Select
Selection.AutoFilter Field:=8, Criteria1:="=*" & sh1.Range("A1").Value & "*", Operator:=xlAnd
End If
✦アクティブなセルから100行までの空白以外でフィルターをかける。
Range(Selection, Selection.Offset(100, 0)).Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
------------------------------------------------------------------------------
✦上の応用で1行目にフィルターを入れてアクティブセルの空白以外を絞り
コピーする。
If Intersect(ActiveCell, Range("A1:Z1")) Is Nothing Then Exit Sub
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With
------------------------------------------------------------------------------
With Sheets("Sheet1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Cells(4, 2)
.AutoFilter Field:=7, Criteria1:=Sheets("Sheet2").Cells(4, 3)
.AutoFilter Field:=9, Criteria1:=Sheets("Sheet2").Cells(4, 4)
End With
------------------------------------------------------------------------------
Worksheets("Sheet1").Range("A1").AutoFilter Field:=13, Criteria1:="<>"
Range("M1").Select 'コピーしたい列
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With
------------------------------------------------------------------------------
Range("A1").AutoFilter Field:=13, Criteria1:="<>"
With ActiveSheet.AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1).Select
End With
------------------------------------------------------------------------------
✦オートフィルターの解除
With ActiveSheet
If .FilterMode Then .ShowAllData
End With
------------------------------------------------------------------------------
✦1行目5列目でフィルターをかけたときに値がない場合。
Range("A1").AutoFilter Field:=5, Criteria1:="<>"
If ActiveSheet.AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "データがありません"
Else
MsgBox "データがあります"
End If
------------------------------------------------------------------------------
✦シート2でフラグを立てた値でシート1をフィルターする。
シート2でフラグを立ててシート1の表を絞り込む。
シート2の5行目にフラグ用の値があるB列で絞りたい箇所に
1を入れてフラグを立てる。
フラグが立った月をシート1で表を絞り込む。
Sub sample()
Dim rngs As Range, rng As Range, xAry, i As Long
With Worksheets("Sheet2")
On Error Resume Next
Set rngs = .Range("C2:C" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
End With
If Not rngs Is Nothing Then
ReDim xAry(1 To rngs.Cells.Count)
For Each rng In rngs
i = i + 1
xAry(i) = rng.Offset(, -1).Value
Next rng
Worksheets("Sheet1").Range("A:A").AutoFilter Field:=1, Criteria1:=xAry, Operator:=xlFilterValues
End If
End Sub
【シート2】フラグ用
【シート2】表
結果【シート1】
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("集計")
Set sh2 = Sheets("テーブル1")
If sh1.Range("A1") <> "" Then
sh2.Select
Selection.AutoFilter Field:=8, Criteria1:="=*" & sh1.Range("A1").Value & "*", Operator:=xlAnd
End If
------------------------------------------------------------------------------
✦アクティブなセルから100行までの空白以外でフィルターをかける。
Range(Selection, Selection.Offset(100, 0)).Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
------------------------------------------------------------------------------
✦上の応用で1行目にフィルターを入れてアクティブセルの空白以外を絞り
コピーする。
If Intersect(ActiveCell, Range("A1:Z1")) Is Nothing Then Exit Sub
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With
------------------------------------------------------------------------------
✦シート２の特定セルの値でシート1表のフィルターをかける。
この場合、シート2のB4・C4・D4の値でシート1を絞る。
.AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Cells(4, 2)
.AutoFilter Field:=7, Criteria1:=Sheets("Sheet2").Cells(4, 3)
.AutoFilter Field:=9, Criteria1:=Sheets("Sheet2").Cells(4, 4)
End With
------------------------------------------------------------------------------
✦1行目13列目で空白以外を絞り込む。
Worksheets("Sheet1").Range("A1").AutoFilter Field:=13, Criteria1:="<>"
Range("M1").Select 'コピーしたい列
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With
------------------------------------------------------------------------------
✦フィルターをかけて可視セルをコピーする。
With ActiveSheet.AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1).Select
End With
------------------------------------------------------------------------------
✦オートフィルターの解除
With ActiveSheet
If .FilterMode Then .ShowAllData
End With
------------------------------------------------------------------------------
✦1行目5列目でフィルターをかけたときに値がない場合。
Range("A1").AutoFilter Field:=5, Criteria1:="<>"
If ActiveSheet.AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "データがありません"
Else
MsgBox "データがあります"
End If
------------------------------------------------------------------------------
✦シート2でフラグを立てた値でシート1をフィルターする。
シート2でフラグを立ててシート1の表を絞り込む。
シート2の5行目にフラグ用の値があるB列で絞りたい箇所に
1を入れてフラグを立てる。
フラグが立った月をシート1で表を絞り込む。
Sub sample()
Dim rngs As Range, rng As Range, xAry, i As Long
With Worksheets("Sheet2")
On Error Resume Next
Set rngs = .Range("C2:C" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
End With
If Not rngs Is Nothing Then
ReDim xAry(1 To rngs.Cells.Count)
For Each rng In rngs
i = i + 1
xAry(i) = rng.Offset(, -1).Value
Next rng
Worksheets("Sheet1").Range("A:A").AutoFilter Field:=1, Criteria1:=xAry, Operator:=xlFilterValues
End If
End Sub
【シート2】フラグ用
【シート2】表
結果【シート1】
2018年3月13日火曜日
【マクロ】置換
✦文字列の空白を消す
Range("A:A").Replace what:=" ", Replacement:="", lookat:=xlPart
------------------------------------------------------------------------------
✦空白に文字
A列の空白セルにハイフンを入れる。
Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).Select
Selection.Value = "-"
------------------------------------------------------------------------------
✦セル参照置換
シート1のA列の値をシート２の値で置換する。
シート1A列に1→シート２のG1の値で
シート1A列に2→シート２のG2の値で置換をする。
Dim s1, s2 As Worksheet
Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")
s1.Range("A:A").Select
With Selection
.Replace What:="1", Replacement:=s2.Range("G1").Value, LookAt:=xlWhole
.Replace What:="2", Replacement:=s2.Range("G2").Value, LookAt:=xlWhole
End With
------------------------------------------------------------------------------
✦一括置換
「Sheet2」に置換リストを作成し、「Sheet1」をマクロで一括変換
①Sheet2にあらかじめ置換リストを作成しておく
【例：Sheet2リスト】
A列 B列
置換前1 置換後1
置換前2 置換後2
置換前3 置換後3
置換前4 置換後4
置換前5 置換後5
【Sheet1】
Sub 置換()
Dim i As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets(Sheet1)
Set wS2 = Worksheets(Sheet2)
For i = 2 To wS2.Cells(Rows.Count, A).End(xlUp).Row
wS1.Cells.Replace what=wS2.Cells(i, A), replacement=wS2.Cells(i, B), lookat=xlPart
Next i
End Sub
Range("A:A").Replace what:=" ", Replacement:="", lookat:=xlPart
------------------------------------------------------------------------------
✦空白に文字
A列の空白セルにハイフンを入れる。
Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).Select
Selection.Value = "-"
------------------------------------------------------------------------------
✦セル参照置換
シート1のA列の値をシート２の値で置換する。
シート1A列に1→シート２のG1の値で
シート1A列に2→シート２のG2の値で置換をする。
Dim s1, s2 As Worksheet
Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")
s1.Range("A:A").Select
With Selection
.Replace What:="1", Replacement:=s2.Range("G1").Value, LookAt:=xlWhole
.Replace What:="2", Replacement:=s2.Range("G2").Value, LookAt:=xlWhole
End With
------------------------------------------------------------------------------
✦一括置換
「Sheet2」に置換リストを作成し、「Sheet1」をマクロで一括変換
①Sheet2にあらかじめ置換リストを作成しておく
【例：Sheet2リスト】
A列 B列
置換前1 置換後1
置換前2 置換後2
置換前3 置換後3
置換前4 置換後4
置換前5 置換後5
【Sheet1】
Sub 置換()
Dim i As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets(Sheet1)
Set wS2 = Worksheets(Sheet2)
For i = 2 To wS2.Cells(Rows.Count, A).End(xlUp).Row
wS1.Cells.Replace what=wS2.Cells(i, A), replacement=wS2.Cells(i, B), lookat=xlPart
Next i
End Sub
2018年3月12日月曜日
覚え書きとして立ち上げ
2018/03/12始動
このブログは個人的に覚え書きとして使用する目的で立ち上げた。
基本的にはマクロ関係の覚え書きとして使用していく。
コードをなかなか覚えられない・・・覚える気も無いが正しいかな。
その都度、ネットで検索するのも面倒だ・・・。
そんなこんなで、ネットで拾ったコードを自分なりに改造した物などの
覚え書きとしたい。
以上。
このブログは個人的に覚え書きとして使用する目的で立ち上げた。
基本的にはマクロ関係の覚え書きとして使用していく。
コードをなかなか覚えられない・・・覚える気も無いが正しいかな。
その都度、ネットで検索するのも面倒だ・・・。
そんなこんなで、ネットで拾ったコードを自分なりに改造した物などの
覚え書きとしたい。
以上。
登録:
投稿 (Atom)