| |
>これでオープンするとファイル見つからないとなります｡
をまずTestしてみます
新規のBookの標準モジュールに以下のコードを記述します
Pathの有る（Range("O29")の有る）、BookをOpenしてActiveにします
VBAEditor上でイミディエイトウィンドウを表示して以下のコードを実行します
文字を１つづつ比較し違いが有れば、イミディエイトウィンドウに表示します
Public Sub Test1()
Const cstrGoodPath As String = "C:\FreeSoft\000EXCEL\設備点検.xls"
Dim i As Long
Dim strFilename As String
Dim strNoGoodPath As String
Dim blnNoMatch As Boolean
Dim strNoGood As String
Dim strGood As String
Dim strType1 As String
Dim strType2 As String
strNoGoodPath = ActiveWorkbook.Worksheets("Menu").Range("O29").Value & "設備点検.xls"
If Len(strNoGoodPath) <> Len(cstrGoodPath) Then
Debug.Print "文字数が違います"
Debug.Print "NoGood = " & Len(strNoGood), "Good = " & Len(cstrGoodPath)
Debug.Print
End If
For i = 1 To Len(strNoGoodPath)
strNoGood = Mid(strNoGoodPath, i, 1)
If 0 <= Asc(strNoGood) And Asc(strNoGood) <= 255 Then
strType1 = "半角"
Else
strType1 = "全角"
End If
strGood = Mid(cstrGoodPath, i, 1)
If 0 <= Asc(strGood) And Asc(strGood) <= 255 Then
strType2 = "半角"
Else
strType2 = "全角"
End If
If strNoGood <> strGood Then
Debug.Print "NoGood = "; strNoGood, strType1, _
"Good = "; strGood, strType2
blnNoMatch = True
End If
Next i
If Not blnNoMatch Then
Debug.Print "全て同じ文字です"
End If
End Sub
次に、以下のコードの"MenuBook.xls"を"Menu"の有るBook名に変更して
「"Menu"の有るBook」と「設備点検.xls」を開き
Test2を実行するとマクロの有るBookのSheet1に、Shnameのに取り出されるシート名と
「設備点検.xls」の該当するシート名が上下に出力されますので、見比べてください
尚、スペースを確認する為、名前の前後に*が付きます
Public Sub Test2()
Dim i As Long
Dim j As Long
Dim k As Long
Dim vntData() As Variant
Dim vntName() As Variant
Dim wksMark As Worksheet
With Workbooks("MenuBook.xls").Worksheets("Menu")
For j = 4 To 10 Step 3
For i = 5 To 29 Step 2
If .Cells(i, j).Value <> "" And .Cells(i, j - 1).Value <> "" Then
ReDim Preserve vntData(k)
vntData(k) = .Cells(i, j - 1).Value
k = k + 1
End If
Next i
Next j
End With
k = 0
With Workbooks("設備点検.xls")
For i = 0 To UBound(vntData)
For Each wksMark In .Worksheets
If StrComp(Trim(wksMark.Name), _
Trim(vntData(i)), vbTextCompare) = 0 Then
ReDim Preserve vntName(k)
vntName(k) = wksMark.Name
k = k + 1
Exit For
End If
Next wksMark
Next i
End With
For i = 0 To UBound(vntData)
vntData(i) = "*" & vntData(i) & "*"
Next i
For i = 0 To UBound(vntName)
vntData(i) = "*" & vntName(i) & "*"
Next i
With ThisWorkbook.Worksheets("Sheet1")
.Cells(1, "A").Resize(, UBound(vntData) + 1).Value = vntData
.Cells(2, "A").Resize(, UBound(vntName) + 1).Value = vntName
End With
End Sub
|
|
Hirofumi
- 05/4/6(水) 22:01 -
