規格を設けて判定するマクロについて教えてください。
下記のようなマクロがあるとき、現在はE列、H列、K列が同じ数値の場合は
塗りつぶしが行われるようになっています。
これを少し改造して、B4セルに公差の数値を入力した時
E列の数値を基準とし、H列、K列がE列からB4セルに入力した公差内なら色を付けるような
マクロを組みたいです。
例えばB4セルに2と入力してあるとします。
E列の数値が4.2だとした場合
H列は2.2、K列は6.2ならE列の数値の±2なので塗りつぶしされる。
E列の数値にB4セルの入力した数値の±をH列、K列を超える場合は
塗りつぶしは行わない、という感じです。
わかりずらい説明で申し訳ありませんが、宜しくお願いします。
Sub 判定仮()
Dim i As Integer, j As Integer
Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0
For i = 3 To 32
If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 2 Then
If Cells(i, "E").Row Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
Cells(i, "L") = "OK"
Else
If Cells(i, "E").Row Mod 2 = 0 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
Cells(i, "L") = "OK"
End If
End If
End If
Next
If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub
規格を設けて判定するマクロについて教えてください。
下記のようなマクロがあるとき、現在はE列、H列、K列が同じ数値の場合は
塗りつぶしが行われるようになっています。
これを少し改造して、B4セルに公差の数値を入力した時
E列の数値を基準とし、H列、K列がE列からB4セルに入力した公差内なら色を付けるような
マクロを組みたいです。
例えばB4セルに2と入力してあるとします。
E列の数値が4.2だとした場合
H列は2.2、K列は6.2ならE列の数値の±2なので塗りつぶしされる。
E列の数値にB4セルの入力した数値の±をH列、K列を超える場合は
塗りつぶしは行わない、という感じです。
わかりずらい説明で申し訳ありませんが、宜しくお願いします。
Sub 判定仮()
Dim i As Integer, j As Integer
Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0
For i = 3 To 32
If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 2 Then
If Cells(i, "E").Row Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
Cells(i, "L") = "OK"
Else
If Cells(i, "E").Row Mod 2 = 0 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
Cells(i, "L") = "OK"
End If
End If
End If
Next
If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub
http://officetanaka.net/excel/vba/vbe/05.htm
の
Sub Sample9()
Dim Code As String
Code = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule.Lines(7, 5)
MsgBox Code
End Sub
のエクセルではなく
アクセスバージョンはないでしょうか？
http://d.hatena.ne.jp/taka_2/20090907/p2
をアクセスの標準モジュールに貼り付けてみたのですが
inFileName = WScript.Arguments(0)
で実行時エラー424になってしまいます。
VBA初心者です。
Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。
1には「apple1.csv」、「orange1.csv」、「banana1.csv」
2には「apple2.csv」、「orange2.csv」、「banana1.csv」
・・・
4には「apple4.csv」、「orange4.csv」、「banana4.csv」
が入っています。
この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1～A10セルを新たなファイルに自動転記する（apple1はA1～A10,apple2はＢ10～B10・・・）といった具合のマクロを組みたいと思っています。
そこで以下のＨＰを参考にし、まずはトップディレクトリである「C:\Sample」の中のすべてのフォルダを表示するプログラムをつくってみようと試みました。
ホームページでは以下のソース
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
Next Folder
End Sub
によってイミディエイトにフォルダを表示する仕様になっています。
実際、私もこのソースで実行したところ、イミディエイトにはトップディレクトリ以下の全ディレクトリ名が表示されました。
これを改良し、２列目に全ディレクトリ名が表示されるプログラムを組みました。ソースは以下です。
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
' Dim i As Integer
' i = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
i = i + 1
Cells(i, 2) = Folder
Next i
End Sub
これを実行したところ、２列目にはすべてのディレクトリは表示されず、一部のディレクトリしか表示されません。
改良の仕方がおそらくまずいと思うのですが、何か私が根本的に間違えている気がするので、ご指摘いただけたら幸いです。
VBA初心者です。
Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。
1には「apple1.csv」、「orange1.csv」、「banana1.csv」
2には「apple2.csv」、「orange2.csv」、「banana1.csv」
・・・
4には「apple4.csv」、「orange4.csv」、「banana4.csv」
が入っています。
この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1～A10セルを新たなファイルに自動転記する（apple1はA1～A10,apple2はＢ10～B10・・・）といった具合のマクロを組みたいと思っています。
そこで以下のＨＰを参考にし、まずはトップディレクトリである「C:\Sample」の中のすべてのフォルダを表示するプログラムをつくってみようと試みました。
ホームページでは以下のソース
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
Next Folder
End Sub
によってイミディエイトにフォルダを表示する仕様になっています。
実際、私もこのソースで実行したところ、イミディエイトにはトップディレクトリ以下の全ディレクトリ名が表示されました。
これを改良し、２列目に全ディレクトリ名が表示されるプログラムを組みました。ソースは以下です。
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
' Dim i As Integer
' i = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
i = i + 1
Cells(i, 2) = Folder
Next i
End Sub
これを実行したところ、２列目にはすべてのディレクトリは表示されず、一部のディレクトリしか表示されません。
改良の仕方がおそらくまずいと思うのですが、何か私が根本的に間違えている気がするので、ご指摘いただけたら幸いです。
VBA初心者です。
Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。
1には「apple1.csv」、「orange1.csv」、「banana1.csv」
2には「apple2.csv」、「orange2.csv」、「banana1.csv」
・・・
4には「apple4.csv」、「orange4.csv」、「banana4.csv」
が入っています。
この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1～A10セルを新たなファイルに自動転記する（apple1はA1～A10,apple2はＢ10～B10・・・）といった具合のマクロを組みたいと思っています。
そこで以下のＨＰを参考にし、まずはトップディレクトリである「C:\Sample」の中のすべてのフォルダを表示するプログラムをつくってみようと試みました。
ホームページでは以下のソース
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
Next Folder
End Sub
によってイミディエイトにフォルダを表示する仕様になっています。
実際、私もこのソースで実行したところ、イミディエイトにはトップディレクトリ以下の全ディレクトリ名が表示されました。
これを改良し、２列目に全ディレクトリ名が表示されるプログラムを組みました。ソースは以下です。
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
' Dim i As Integer
' i = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
i = i + 1
Cells(i, 2) = Folder
Next i
End Sub
これを実行したところ、２列目にはすべてのディレクトリは表示されず、一部のディレクトリしか表示されません。
改良の仕方がおそらくまずいと思うのですが、何か私が根本的に間違えている気がするので、ご指摘いただけたら幸いです。
お世話になります。
以前、下記質問をし、締め切ったのですが、もう一点、教えていただきたい点がありました。
質問
エクセルマクロで、sheet1のE列の6～30行に指定する文字が入力された際、
B列のその同じ行にある文字を取得し、その取得した文字をsheet3のC6から
K6まで書き出していきたいのですが、どのようにしたらよいでしょうか？
ご回答
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim r As Range
Const 指定文字 As String = "X"
Set r = Range("E6:E30")
If Target.Count > 1 Then Exit Sub
If Intersect(r, Target) Is Nothing Then
Exit Sub
End If
If Target.Value <> 指定文字 Then
Exit Sub
Else
'大文字小文字を区別する場合
i = ActiveSheet.Evaluate( _
"SumProduct(EXACT(" & r.Address & ",""" & 指定文字 & """)*1)")
'大文字小文字を区別しない場合
i = WorksheetFunction.CountIf(r, 指定文字)
Application.EnableEvents = False
Worksheets("Sheet3").Cells(6, i + 2) = _
Target.Offset(, -3)
Application.EnableEvents = True
End If
End Sub
このご回答を、
取得した文字をsheet3のC6からK6までに4列毎に書き出して
いく場合にはコードをどのようにしていけば良いのでしょうか。
C6→H6→M6→・・・
すみません、再度お願い致します。
エクセル2013です。他のエクセルブックからリンクを張っているとき、以下のマクロで調べることがわかりましたけど、そこでわかるのは、ブック名どまりであって、シートやセル番地はわかりません。わかりたいのは、こっちのブックのどのシートのどのセルが、あっちのブックのどのシートのどのセルとつながっているかです。
わかる方法はないものでしょうか。なお、このマクロは、以下のホームページに書いてあったものです。
https://www.moug.net/tech/exvba/0060039.html
Sub GetLinkInfromation()
Dim Var As Variant
Dim Msg As String
Dim i As Integer
Var = ActiveWorkbook.LinkSources(xlExcelLinks)
For i = 1 To UBound(Var)
Msg = Msg & Var(i) & vbCrLf
Next i
MsgBox Msg
End Sub
