Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


57570 / 76738 ←次へ | 前へ→

【23904】Re:開かれていない別のブックのシートの...
発言  Hirofumi  - 05/4/6(水) 22:01 -

引用なし
パスワード
   >これでオープンするとファイル見つからないとなります。
をまずTestしてみます
新規のBookの標準モジュールに以下のコードを記述します
Pathの有る(Range("O29")の有る)、BookをOpenしてActiveにします
VBAEditor上でイミディエイトウィンドウを表示して以下のコードを実行します
文字を1つづつ比較し違いが有れば、イミディエイトウィンドウに表示します

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

0 hits

【23886】開かれていない別のブックのシートの追加 okb 05/4/6(水) 14:15 質問
【23889】Re:開かれていない別のブックのシートの... okb 05/4/6(水) 16:18 質問
【23904】Re:開かれていない別のブックのシートの... Hirofumi 05/4/6(水) 22:01 発言
【23905】Re:開かれていない別のブックのシートの... okb 05/4/7(木) 0:01 お礼
【23926】Re:開かれていない別のブックのシートの... Hirofumi 05/4/7(木) 19:00 回答
【23927】Re:開かれていない別のブックのシートの... Hirofumi 05/4/7(木) 19:18 回答
【23929】Re:開かれていない別のブックのシートの... okb 05/4/7(木) 23:33 お礼

57570 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free