test1は、Ａ～Ｘ列に数字と条件付き書式をセットするマクロですが、途中のセルから色化けします。
原因がお分かりの方はご教授ください。どうもExcel2010のバグのように思われます。
バグならMicrosoftのどこに報告あるいは問い合わせれば良いでしょうか。
Sub test1()
Dim aRow As Long
Dim aCol As Long
With ActiveSheet
For aRow = 1 To 3
For aCol = 1 To 25
.Cells(aRow, aCol).Value = aCol
Call SetFormatConditionOfColor(aRow, aCol, "=1")
Next
Next
End With
End Sub
Public Sub SetFormatConditionOfColor(ByVal aRow As Long, ByVal aCol As Long, ByVal aFormula As String)
With ActiveSheet.Cells(aRow, aCol)
.FormatConditions.Delete
'一致するセル
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:=aFormula
With .FormatConditions(1)
.Font.Color = 0
.Interior.Color = 13434879
End With
'一致しないセル
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:=aFormula
With .FormatConditions(2)
.Font.Color = 16777215
.Interior.Color = 16767843
End With
End With
End Sub
ＯＳ： MS WindowsXP Professional Service Pack3
Excel： Microsoft Office Professional Plus 2010 14.0.5128.5000(32ビット)
下記のVBAでExcel2003では出来たのですが、Excel2010ではエラーになります。
Excel2003と同じような動作をExcel2010で行いたいのですが、どこをどのように変えたら使用できるようになるでしょうか？
ネットで調べても初心者なもので全くわかりません。
Userform1に作成しているチェックボックスを選択すると、そのチェックボックスに対するドライブからファイルが検索される仕様になってます。
説明が下手で申し訳ありませんが、よろしくお願いします。
Private Sub CommandButton1_Click()
Set FSO = CreateObject("Scripting.FileSystemObject")
For x = 1 To 17
If Me.Controls("CheckBox" & x) = True Then Exit For 'チェックしてあるかを確認
If x = 18 Then Exit Sub
Next x
buf = InputBox("検索したいファイル名を入力してください" & vbCrLf & "ただし、複数キーワード検索はできません" & vbCrLf & "キーワード入力後、「ＯＫ」ボタンを選択", "キーワード入力")
If buf = "" Or buf = "False" Then Exit Sub
For x = 1 To 17
If Me.Controls("CheckBox" & x) = True Then
ドライブ = Chr(Asc("J") + x - 1)
Sheets(x + 1).Visible = True
Sheets(x + 1).Select
Cells(1, 1).Select
With Application.FileSearch
.NewSearch
.LookIn = ドライブ & ":\"
.Filename = buf
.SearchSubFolders = True
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " 個のファイルが見つかりました", vbOKOnly, "検索結果"
b = 1
Application.ScreenUpdating = False
For Each f In .FoundFiles
a = Range("C65536").End(xlUp).Row + 1
Cells(a, 2) = b
Cells(a, 3) = FSO.getfile(f).Name
Cells(a, 4) = FSO.getfile(f).DateLastModified
Cells(a, 5) = FSO.getfile(f).Path
b = b + 1
Next f
Else
MsgBox "見つかりませんでした"
Sheets(x + 1).Visible = False
End If
End With
For i = 5 To a Step 1
Cells(i, 3).Select
With ActiveSheet
.Hyperlinks.Add Anchor:=Selection, Address:=Cells(i, 5).Value
End With
Next i
If Range("E5") = "" Then
End
Else
Range(Cells(5, 5), Cells(a, 5)).Clear
End If
End If
Next x
Set FSO = Nothing
Cells(1, 1).Select
Unload UserForm1
End Sub
このサイトで、セル範囲を表記するのに [B10:C11] のような書き方をはじめて見ました。
以下のように試してみました。
Sub test01()
Range("B10:C11").Select
End Sub
Sub test02()
[B10:C11].Select
End Sub
まったく同じように働きます。
これは、Range("B10:C11") と、[B10:C11] は同じ意味だということでしょうか？
同じなら、この方が文字数も少なく書きやすいと思うのですが、あまり見かけないのはなぜでしょうか？
また、変数を使おうと
Sub test03()
X = 11
Range("B10:C" & X).Select
End Sub
を次のように書き換えましたところ、「オブジェクトが必要です」という実行時エラーになってしまいました。
Sub test04()
X = 11
[B10:C & x].Select
End Sub
この書き方は変数は組み合わせられないのでしょうか？
excelのvbaについてです。
日付 取引先 金額
------------------------------
3月20日 ○○様 ￥２０，０００
4月23日 △△様 ￥１９，０００
5月23日 ○○様 ￥５，０００
・・・・・
・・・
・・
というような表から、INPUTBOXで入力した抽出条件でデータを取り出したいと思っています。
Dim aa As String, i As Integer
aa = InputBox("抽出する取引先を入力してください")
i = InputBox("抽出を開始する月は？※半角数字で入力してください")
ii = InputBox("抽出を終了する月は？※半角数字で入力してください")
Selection.AutoFilter field:=1, Criteria1:=aa
Selection.AutoFilter field:=2, Criteria1:=">=" & i & "月1日", Operator:=xlAnd, Criteria2:="<=" & ii & "月31日"
End Sub
としたのですが、月によって30日で終わる月もあれば、28日、29日で終わる月もありますよね。
どんな月の範囲指定をしても、ちゃんと抽出できるようにするにはどうしたらいいでしょうか？
諸先輩方、どうぞよろしくお願いします。
現在、顧客毎の支払い明細をExcelで自動発行できるものを作っています。
独学で、以下の状態までは作成できたのですが、その後、どうすれば良いのか分かりません。
[入力シート] ※以下、項目名はA6:O6に記載。
A=No. F=科目名 K=該当期間
B=顧客ID G=業者名 L=本体金額
C=顧客名 H=摘要【抜粋】 M=消費税
D=大項目 I=摘要 N=合計
E=勘定科目 J=説明 O=計上月
上記[入力シート]内の「C=顧客名×O=計上月」を抽出条件としたフィルタオプションで転記
というコードは、下記で成功しました。
※コード内の「顧客テーブル=入力シートの全データ」。「Q_抽出条件=顧客名×計上月」の条件
----------------------------------
Sub 必要なフィールドのみを転記()
Dim myTable As Range, myQuery As Range, taegetRnage As Range
Set myTable = Worksheets("入力Form").Range("顧客テーブル")
Set myQuery = Worksheets("入力Form").Range("Q_抽出条件")
Set targetRange = Worksheets("必要項目のみ転記").Range("b3:l3")
myTable.AdvancedFilter xlFilterCopy, myQuery, targetRange
End Sub
----------------------------------
また、顧客名毎にシート作成し、転記ということも以下コードで成功しています。
※コード内の「myList = Array("顧客A","顧客B","顧客C"・・・・・・・・・・)」は、顧客数分、名前を記載してあります。
----------------------------------
Sub 物件毎に転記()
Dim myTable As Range, mysheet As Worksheet, i As Integer
Dim myList()
myList = Array("顧客A","顧客B","顧客C"・・・・・・・・・・)
Set myTable = Worksheets("入力Form").Range("顧客テーブル")
For i = o To UBound(myList)
Set mysheet = Worksheets.Add(after:=Sheets(Sheets.Count))
mysheet.Name = myList(i) & "_支払明細"
With myTable
.AutoFilter 3, myList(i)
.Copy mysheet.Range("a2")
.AutoFilter
End With
mysheet.Range("a2").CurrentRegion.EntireColumn.AutoFit
Next
End Sub
----------------------------------
まず、顧客数分の抽出先（転記先）明細シートを用意し、必要な項目名だけを
記載しておくので、そこに「顧客名」×「計上月」の抽出条件で抽出された内容を
顧客別に指定シートに、転記したいのです。
※「顧客名」で転記先シートを予め指定できるのであれば、抽出条件は「計上月」だけで構いません。
顧客数が30件程あり、毎月、入力シートに売上データは追記されていきます。
その蓄積されていくデータの中から、一括で「(1)計上月指定 (2)顧客名別の指定シートに該当データのみを転記 (3)顧客名に該当する転記先シートがなければ、新しくシートを作成した上で転記」
という作業を行いたいと考えています。
※(3)は、Want条件なのでなくても大丈夫です。
あまりVBAの知識がない為、コードの記載方法など詳細に教えていただければ幸いです。
何卒よろしくお願い致します。
