Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7 Professional : Excel 2013)
ループ回数について
投稿日時: 19/05/21 17:39:18
投稿者: current

いつもお世話になっております。下記コードについて完全に理解できておりませんので質問させてください。これまでの質問とは別の質問になりますのでよろしくお願いいたします。
ループ回数についてですが、コピーしたいファイルが任意の数あり、繰り返しループさせていますが、コピー先のファイルを含めない数だけループさせたいのですが、コピー先のファイルが含まれてしまい1回多くループされてしまいます。どうしても理解できないので、こんな私でもわかるようにご説明よろしくお願いします。
 
 

Option Explicit

Sub sheets_combine_to_summarizing()

    Dim filename, scdrange, bookname As String
    Dim a As Long
    Dim currentbook As Workbook

    'Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = True
    Application.Calculation = xlManual  '計算方法 手動
    a = 1
    filename = Dir(ThisWorkbook.Path & "\*.*")
    Do While filename <> Empty
        If LCase(ThisWorkbook.Path) Like "*.csv" Or _
           LCase(ThisWorkbook.Path) Like "*xls*" Then
        End If
        If filename > ThisWorkbook.Count Then '統合先ブックと異なるブック名であれば
            Set currentbook = Workbooks.Open(ThisWorkbook.Path & "\" & filename, ReadOnly:=True)
            currentbook.Worksheets.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            bookname = currentbook.Name
            currentbook.Close
        End If
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range(Range("A1"), Range("A1").CurrentRegion).Copy
        Worksheets(1).Select
        Cells(1, a).PasteSpecial Paste:=xlPasteValues
        filename = Dir 'フォルダ内の次のブック名を取得
        a = a + 2
    Loop
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
End Sub

投稿日時: 19/05/21 17:46:37
投稿者: current

すみません、修正中のコードをのせてしまいましたので差し替えさせていただきます。
 

Option Explicit

Sub sheets_combine_to_summarizing()

    Dim filename, scdrange, bookname As String
    Dim a As Long
    Dim currentbook As Workbook

    'Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = True
    Application.Calculation = xlManual  '計算方法 手動
    a = 1
    filename = Dir(ThisWorkbook.Path & "\*.*")
    Do While filename <> Empty
        If LCase(ThisWorkbook.Path) Like "*.csv" Or _
           LCase(ThisWorkbook.Path) Like "*xls*" Then
        End If
        If filename <> ThisWorkbook.Name Then '統合先ブックと異なるブック名であれば
            Set currentbook = Workbooks.Open(ThisWorkbook.Path & "\" & filename, ReadOnly:=True)
            currentbook.Worksheets.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            bookname = currentbook.Name
            currentbook.Close
        End If
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range(Range("A1"), Range("A1").CurrentRegion).Copy
        Worksheets(1).Select
        Cells(1, a).PasteSpecial Paste:=xlPasteValues
        filename = Dir 'フォルダ内の次のブック名を取得
        a = a + 2
    Loop
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
End Sub


回答
投稿日時: 19/05/21 18:24:59
投稿者: Suzu

引用:
If filename <> ThisWorkbook.Name Then '統合先ブックと異なるブック名であれば

 
??? 合って居そうに見えますが。。。
 
ここにブレイクポイントを設定し、
コードが停止した段階で
・filename
・ThisWorkbook.Name
各変数上にカーソルを移動させ値を確認してみてください。

投稿日時: 19/05/21 18:58:07
投稿者: current

ご回答ありがとうございます。
F8で1つずつ動作確認しましたが、コピー先のファイル分も含めた数がループされます。その時にファイルネームもコピー先になっていることを確認しましたので、間違いないと思います。

回答
投稿日時: 19/05/21 19:13:56
投稿者: WinArrow
投稿者のウェブサイトに移動

 DO文の次の↓のコードはmどのような意図なんですか?
> If LCase(ThisWorkbook.Path) Like "*.csv" Or _
> LCase(ThisWorkbook.Path) Like "*xls*" Then
> End If

投稿日時: 19/05/21 19:26:12
投稿者: current

ご回答ありがとうございます。こちらはExcelの拡張子ならどのファイルでも開けるようにするために入れています。

回答
投稿日時: 19/05/21 19:53:31
投稿者: WinArrow
投稿者のウェブサイトに移動

current さんの引用:
ご回答ありがとうございます。こちらはExcelの拡張子ならどのファイルでも開けるようにするために入れています。

 
そうですか・・・・
 
2つン問題があります。
 
1つ目の問題点
  判断対象があなたの意図と違います。
  先入観を捨てて、じっくり見直してみましょう。
 
2つ目の問題点
  End Ifの場所が不適切です。
  このままでは、IF〜End IFは、存在する意味がありません。
  こちらも、  先入観を捨てて、じっくり見直してみましょう。
 
 
 
 
 

回答
投稿日時: 19/05/21 22:44:11
投稿者: simple

        If filename <> ThisWorkbook.Name Then の行の前に

        Debug.Print filename <> ThisWorkbook.Name; "  "; filename
        If filename <> ThisWorkbook.Name Then 
として、
事実をよく確認してはどうですか?
 
ちなみに、もうひとつの質問について、
途中まで改善コードを書いているのですが、
あなたの回答が無いのでコメントができません。
もう諦めたのですか?

回答
投稿日時: 19/05/22 12:01:56
投稿者: Suzu

ご質問そのものの回答は質問者さんの確認待ちの状態です。
 
 
直接の回答ではありませんが既出の
・Excel ファイルの判定 の End If の位置
・ファイル名判定の End If の位置
  (上記二つは、現状だとファイルがなにであれテキスト区切り処理を行いコピペします
   Excelファイルだったら テキスト区切り処理後コピペを行うべきと思われる)
 
他にも、
表の使用範囲 の コピーであれば
Range("A1").CurrentRegion.Copy で良いでしょう。
 
また、上記でコピーされる行は 2行と決まっているのでしょうか?
決まっていないなら a = a + 2 ではまずいですが。。
 
 
 
処理速度云々や、画面更新を抑制する 再計算のタイミング抑制 等は ロジックがうまくいってからの話です。
今回の様なデバッグの段階では、全部コメントアウトしておきましょう。

回答
投稿日時: 19/05/22 18:37:54
投稿者: WinArrow
投稿者のウェブサイトに移動

Suzuさん、レス

引用:

また、上記でコピーされる行は 2行と決まっているのでしょうか?
決まっていないなら a = a + 2 ではまずいですが。。

変数:a
は、列で使っているようです。
TextToColumnsメソッドで
FieldInfo:=Array(Array(1, 1), Array(2, 1))
というように2列指定していますから、整合していると思います。
データ型が2列とも数値になっているが、元データに「カンマ」がある?
というのが気になります。
CSVファイルも対象にしているので、「,」があると???

回答
投稿日時: 19/05/22 19:46:31
投稿者: WinArrow
投稿者のウェブサイトに移動

CSVデータの中に「,」付きの数字
パターン1
123,456
の場合 → Excelで開くと、セルA1に「123」、B1に「456」と入ります。
TexttoColumnメソッドでは、「123」が対象になります。
 
パターン2
"123,456"
の場合→ Excelで開くと、セルA1に「123456」但し、見た目「123,456」
TexttoColumnメソッドでは、「123456」が対象になります。
 
要するに、どちらの場合も、分割されないということにならないでしょうか?

回答
投稿日時: 19/05/23 22:09:22
投稿者: simple

引用:
> F8で1つずつ動作確認しましたが、
> コピー先のファイル分も含めた数がループされます。
> その時にファイルネームもコピー先になっていることを確認しました
とのことです。
 
貴兄のコードについての私の理解は次のようなものです。
以下では、コードが書かれているブックを Aブックと書きます。
1)Aブックがあるフォルダのファイルのファイル名を取得します。
2)そのファイル名が、Aブックの名前と異なれば、
  そのファイルを開き、Aブックの最終シートの後ろにコピーします。
3)上記1)2)の作業をすべてのファイルについて繰り返します。

> コピー先のファイル分も含めた数がループされます。
コピー先のファイル分とは、上記のAブックのことですか?
ループはされますが、そのファイルの名前はAブックの名前ですから、
2)の条件を満たしませんから、Aブックは開かれません。
 (すでに開かれているわけだし、
   仮に開こうとしても、同一の名前のブックを2つ開くことはできません)
 
【質問】
> その時にファイルネームもコピー先になっている
と言う文章の意味を、詳しく説明してください。
ファイルネームとは、何のファイル名ですか?
もともとのAブックとの関係は?
コピー先になっているとは?
 
-------------------------------------
勝手な想像だが、
filename = ThisWorkbook.Nameが成立(Aブックと一致)した場合でも
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
          Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
          :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Range(Range("A1"), Range("A1").CurrentRegion).Copy
    Worksheets(1).Select
    Cells(1, a).PasteSpecial Paste:=xlPasteValues
    filename = Dir    'フォルダ内の次のブック名を取得
    a = a + 2

が実行されていることが、想定外の印象を与えているのでは?
 
こんな風にでも書くものでは?
Do While filename <> Empty
    If filename <> ThisWorkbook.Name Then    '統合先ブックと異なるブック名であれば
        Set currentbook = Workbooks.Open(ThisWorkbook.Path & "\" & filename, ReadOnly:=True)
        currentbook.Worksheets.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set ws = ActiveSheet
        
        currentbook.Close
        ws.Columns("A:A").TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, _
           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
           Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
           :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        ws.Range(ws.Range("A1"), ws.Range("A1").CurrentRegion).Copy
        ThisWorkbook.Worksheets(1).Cells(1, a).PasteSpecial Paste:=xlPasteValues
        a = a + 2
    End If
    filename = Dir    'フォルダ内の次のブック名を取得
Loop
想像で書いています。
当方では確認していないので、そちらで確認してください。

回答
投稿日時: 19/05/25 13:29:52
投稿者: simple

上記の私の指摘は、すでにSuzuさんが 19/05/22 12:01:56にされていました。
失礼しました。
# 質問者さんが反応されないと、前に進みません。

トピックに返信