EXCEL VBA --
参考URL：
'--------------------------------------------------
Sub 値の代入01()
Dim cl As Range
Dim r As Range
Set r = Application.InputBox("範囲は？", Type:=8)
’検索範囲のセルの値が「2」だったら・・・
For Each cl In r
If cl = 2 Then
x = cl.Offset(0, 1)
cl.Offset(1, 1) = x
End If
Next
Set r = Nothing
End Sub
'--------------------------------------------------
Sub 値の代入02()
Dim cl As Range
Dim r As Range
Dim バージョン As String
Dim x As Long
Set r = Application.InputBox("元データの範囲は？", Type:=8)
バージョン = InputBox("入力する情報は？")
x = InputBox("何個右に入力する？")
For Each cl In r
If cl <> "" Then
cl.Offset(0, x) = バージョン
End If
Next
Set r = Nothing
End Sub
'--------------------------------------------------
Sub 機種名をA列に()
Dim 機種 As String
Dim 台数 As Long
Dim i As Long
Columns("A:AZ").Select
Selection.EntireColumn.Hidden = False
機種 = InputBox("機種は？")
台数 = InputBox("台数は？")
'コピーや切取りの操作を取り消します
Application.CutCopyMode = False
'行を追加します
Columns(1).Insert
For i = 2 To 台数 + 2
Cells(i, 1) = 機種
Next i
Range("A1").Select
End Sub
'--------------------------------------------------
Sub 再表示()
'非表示の列を再表示させる。フィルターを”全て表示”にする。
'セルの結合をしてある場合があるので、1〜4行目まで調べて一番多い数を採用する
壱 = Range("IV1").End(xlToLeft).Column
弐 = Range("IV2").End(xlToLeft).Column
参 = Range("IV3").End(xlToLeft).Column
四 = Range("IV4").End(xlToLeft).Column
If 壱 > 弐 Then
右端cl = 壱
Else
右端cl = 弐
End If
If 右端cl > 参 Then
Else
右端cl = 参
End If
If 右端cl > 四 Then
Else
右端cl = 四
End If
'MsgBox 右端cl
For i = 1 To 右端cl
Columns(i).Select
Selection.EntireColumn.Hidden = False
Next i
'フィルター外し
For i = 1 To 右端cl
Range("A1").AutoFilter Field:=i
Next i
Range("A1").Select
End Sub
'--------------------------------------------------
|
|
