Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : その他)
CSVデータをG列2行から出力させたい
投稿日時: 23/01/30 14:29:25
投稿者: ラブ

お世話になっております。
 
CSVのデータをG列2行目から右側に出力したいです。
 ※1行目から出力するのは無事に作る事ができました。
 
.Range("G:G").PasteSpecial Paste:=xlPasteValues

.Range("G2").PasteSpecial Paste:=xlPasteValues
とすると、
実行時エラー1004
コピー領域と貼付領域の形が違うため、情報を貼り付ける事ができません。
情報を貼り付けるには、次のいずれかの操作を行ってください。
と表示されます。
エクセルの機能として、CSVの全体のデータをExcelに貼り付ける際の範囲と貼り付け方の問題かと思いますが
それをVBAで表現が難しいです。
 
大変恐縮ですが、わかる方教えて頂ければ幸いです。
 大変申し訳ございません。
 
オフィスは2010を利用しています。
 ※古くて申し訳ございません。
 
 
*******************  ソース全体  *********************
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'*******************************************************************************
' CSVファイルの読み込み処理(FSOのTextStreamを使い、カンマ数に依存しない処理)
'
'*******************************************************************************
Option Explicit
'Private Const CNS_SC = "'" ' シングルクォーテーション
'Private Const CNS_DC = """" ' ダブルクォーテーョン
'Private Const CNS_COMM = "," ' カンマ
'Public Const g_cnsTitle = "ワークシートからMDBへのインポート"
'Const g_cnsMDBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Public g_swOK As Boolean
 
'*******************************************************************************
' CSVファイルの読み込み処理
'*******************************************************************************
Sub 在庫()
    Dim xlAPP As Application
    Dim objFSO As FileSystemObject
    Dim objTS As TextStream
    Dim strFILENAME As String
    Dim vntREC As Variant
    Dim GYO As Long
    Dim COL As Long
    Dim cntREC As Long
    Dim ZR As String
     
    Const STR_SAVE_FilePath = "\\Xc446999p\c446999pn\製造企画室\鈴木\石尾\月末在庫"
    Const STR_SAVE_Filename1 = "検収明細抽出"
    Const STR_SAVE_Filename2 = "ライン別売上(九州)"
    Const STR_SAVE_Filename3 = "ライン別組立重量"
    Const STR_SAVE_Filename4 = "月末在庫"
    Const STR_SAVE_FileFormat = "CSV"
    Dim obj_WB As Workbook, obj_dlWB As Workbook
    Dim lng_EndRow As Long
    Dim obj_ie As Object
    Dim ret As String
    Dim FRngRow As Long
    'Dim maxDate As Date
     
    Set obj_WB = ThisWorkbook
         
     
     
    '画面更新停止
    Application.Calculation = xlCalculationManual '手動計算
     
     
    '確認シート 検収明細抽出 前月明細 G列〜BG列削除
    With obj_WB.Worksheets("確認シート")
        .Range("G:BG").Clear
    End With
     
    '物件完了シート ライン別売上(九州) 前月明細 B列〜AF列削除
    With obj_WB.Worksheets("物件完了")
        .Range("B:AF").Clear
    End With
     
     
    '組立完了シート ライン別組立重量 B列〜P列削除
    With obj_WB.Worksheets("組立完了")
        .Range("B:P").Clear
    End With
     
     
 
    '------CSVのときここから----
    '------検収明細抽出---------
 
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename1 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename1)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1) _
            , Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1) _
            , Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1) _
            , Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:BA").Copy
    End With
     
     
    'ペースト
    With obj_WB.Worksheets("確認シート")
        .Activate
        .Range("G:G").PasteSpecial Paste:=xlPasteValues  →  ここの部分をG2セルから右に出力させたい。
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
               
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename2 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename2)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:O").Copy
    End With
     
      
    'ペースト
    With obj_WB.Worksheets("物件完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
           
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename3 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename3)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:AE").Copy
    End With
     
                 
    'ペースト
    With obj_WB.Worksheets("組立完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
     
    '画面更新再開
    Application.Calculation = xlCalculationAutomatic '自動計算
     
 
End Sub
 
 
 
         

回答
投稿日時: 23/01/30 14:47:34
投稿者: taitani
投稿者のウェブサイトに移動

複数列を取得している状態で、単一セルに貼り付けようとしているので、
 

引用:
実行時エラー1004
コピー領域と貼付領域の形が違うため、情報を貼り付ける事ができません。

のエラーが発生している見解です。
 
そのため、データを列単位ではなく、配列で読み込んで保管すると、希望の動作ができると思います。
下記ページを参考に、作り直してみるのがよいでしょう。
 
https://www.moug.net/tech/exvba/0060083.html

回答
投稿日時: 23/01/30 15:28:02
投稿者: taitani
投稿者のウェブサイトに移動

一応・・・ (動作確認は行っていません。。。)
----
Dim Lastrow As long
を追加
 
〜〜
Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename1 & "." & STR_SAVE_FileFormat)
の下に、
Lastrow=obj_dlWB.Cells(Rows.Count, 1).End(xlUp).Row
を追加。
 
.Range("A:BA").Copy

.Range("A1:BA" & Lastrow).Copy
に変更
 
.Range("G:G").PasteSpecial Paste:=xlPasteValues

 
.Range("G2").PasteSpecial Paste:=xlPasteValues
に変更で良いかも。
 
 

回答
投稿日時: 23/01/30 16:11:21
投稿者: taitani
投稿者のウェブサイトに移動

蛇足かもしれませんが何点か。(何度も追記すみません)
1.「'画面更新停止」とありますが、停止の命令が記載されてない。
以下コードを追記してください。
Application.ScreenUpdating = False
 
2.「'画面更新再開」とありますが、再開の命令が記載されてない。
以下コードを追記してください。
Application.ScreenUpdating = True
 
3.「Dim lng_EndRow As Long」を見逃していましたので、
「Lastrow」の下りを 「lng_EndRow」でもよいです。

回答
投稿日時: 23/01/30 17:15:37
投稿者: simple

列そのものを、1行目ではないセル以降に貼り付けると、
寸法が足りなくなって、Excelが音を上げているのでは?
そのあたりを検討されたらいかがでしょうか。

投稿日時: 23/01/30 17:37:42
投稿者: ラブ

お世話になっております。
 
色々アドバイスをありがとうございます。
 
教えて頂いた内容を元に修正したソースを作成してみました。
月初に利用するツールなので、2月頭に利用してみて、また状況をお伝えさせて下さい。
 ※利用者に確認してもらいます。

投稿日時: 23/02/06 11:15:38
投稿者: ラブ

お世話になっております。
すいません。
教えて頂きました、内容を適用して実行していますが、こちらのエラーが表示されました。
 
実行時エラー438
オブジェクトはこのプロパティまたはメソッドをサポートしていません。
 
Lastrowをlng_EndRowに変更してみましたが、やはり同じエラーが表示されます。
 
とりあえず、2月の月次は別の方法で処理してもらいました。
 
つきましては、どうしたら良いでしょうか?
※大変申し訳ございません。
 
 
 
↓ ↓ ↓ プログラム全文 ↓ ↓ ↓
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'*******************************************************************************
' CSVファイルの読み込み処理(FSOのTextStreamを使い、カンマ数に依存しない処理)
'
'*******************************************************************************
Option Explicit
'Private Const CNS_SC = "'" ' シングルクォーテーション
'Private Const CNS_DC = """" ' ダブルクォーテーョン
'Private Const CNS_COMM = "," ' カンマ
'Public Const g_cnsTitle = "ワークシートからMDBへのインポート"
'Const g_cnsMDBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Public g_swOK As Boolean
 
'*******************************************************************************
' CSVファイルの読み込み処理
'*******************************************************************************
Sub 在庫()
    Dim xlAPP As Application
    Dim objFSO As FileSystemObject
    Dim objTS As TextStream
    Dim strFILENAME As String
    Dim vntREC As Variant
    Dim GYO As Long
    Dim COL As Long
    Dim cntREC As Long
    Dim ZR As String
     
    Const STR_SAVE_FilePath = "\\Xc446999p\c446999pn\製造企画室\鈴木\石尾\月末在庫"
    Const STR_SAVE_Filename1 = "検収明細抽出"
    Const STR_SAVE_Filename2 = "ライン別売上(九州)"
    Const STR_SAVE_Filename3 = "ライン別組立重量"
    Const STR_SAVE_Filename4 = "月末在庫"
    Const STR_SAVE_FileFormat = "CSV"
    Dim obj_WB As Workbook, obj_dlWB As Workbook
    Dim lng_EndRow As Long
    Dim obj_ie As Object
    Dim ret As String
    Dim FRngRow As Long
    Dim Lastrow As Long
    'Dim maxDate As Date
     
    Set obj_WB = ThisWorkbook
         
     
     
    '画面更新停止
    Application.Calculation = xlCalculationManual '手動計算
    Application.ScreenUpdating = False '画面がカタカタ動くの停止
     
     
    '確認シート 検収明細抽出 前月明細 G列〜BG列削除
    With obj_WB.Worksheets("確認シート")
        .Range("G:BG").Clear
    End With
     
    '物件完了シート ライン別売上(九州) 前月明細 B列〜AF列削除
    With obj_WB.Worksheets("物件完了")
        .Range("B:AF").Clear
    End With
     
     
    '組立完了シート ライン別組立重量 B列〜P列削除
    With obj_WB.Worksheets("組立完了")
        .Range("B:P").Clear
    End With
     
     
 
    '------CSVのときここから----
    '------検収明細抽出---------
 
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename1 & "." & STR_SAVE_FileFormat)
     
    Lastrow = obj_dlWB.Cells(Rows.Count, 1).End(xlUp).Row '20230206追加
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename1)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1) _
            , Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1) _
            , Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1) _
            , Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1)), TrailingMinusNumbers:=True
         
        'コピー
        '.Range("A:BA").Copy
        .Range("A1:BA" & Lastrow).Copy '20230206修正
    End With
     
     
    'ペースト
    With obj_WB.Worksheets("確認シート")
        .Activate
        '.Range("G:G").PasteSpecial Paste:=xlPasteValues
        .Range("G2").PasteSpecial Paste:=xlPasteValues '20230206修正
    End With
     
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
               
           
    '------CSVのときここから-------
    '------ライン別売上(九州)----
     
     
     
   
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename2 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename2)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:O").Copy
    End With
     
      
    'ペースト
    With obj_WB.Worksheets("物件完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
           
               
           
    '------CSVのときここから-----------
    '------ライン別組立重量------------
     
     
     
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename3 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename3)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:AE").Copy
    End With
     
                 
    'ペースト
    With obj_WB.Worksheets("組立完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
           
           
    '------CSVのときここまで------
     
     
    '画面更新再開
    Application.Calculation = xlCalculationAutomatic '自動計算
    Application.ScreenUpdating = True '画面がカタカタ動くの再開
     
     
 
End Sub

投稿日時: 23/02/06 11:19:13
投稿者: ラブ

お世話になっております。
追記致します。
 
エラーメッセージはLastlowの部分で表示されます。
 
お手数おかけして、大変申し訳ございません。
 

回答
投稿日時: 23/02/06 11:44:57
投稿者: simple

    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename1 & "." & STR_SAVE_FileFormat)
    Lastrow = obj_dlWB.Cells(Rows.Count, 1).End(xlUp).Row '20230206追加

obj_dlWBはWorkbookですので、それはRangeオブジェクト(セル範囲)を持てません。
WorkBook - Worksheet - セル範囲 という階層構造に忠実に従う必要があります。
    Lastrow = obj_dlWB.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
といったものに修正してみたらいかがですか?

回答
投稿日時: 23/02/06 11:45:04
投稿者: taitani
投稿者のウェブサイトに移動

taitani さんの引用:

3.「Dim lng_EndRow As Long」を見逃していましたので、
「Lastrow」の下りを 「lng_EndRow」でもよいです。

 
上記の通り、Lastrow を lng_EndRow に差し替えるんですよ。
 
おそらく、
引用:
'コピー
        '.Range("A:BA").Copy
        .Range("A1:BA" & Lastrow).Copy '20230206修正
    End With

 
ここで、エラーになってる見解です。

回答
投稿日時: 23/02/06 11:48:53
投稿者: simple

追記です。
> Lastrow = obj_dlWB.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
>といったものに修正してみたらいかがですか?

ワークシート名を正確に指定してください。

投稿日時: 23/02/06 12:38:27
投稿者: ラブ

お世話になっております。
 
ありがとうございます。
すいません。
 
実行時エラー9
こちらの様に修正してみたのですが、インデックスが有効範囲にありません。
 
と、lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row '20230206
で、表示されます。
 
lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row の
Rows.Countは「1058476」になっております。
 
エクセルの拡張子は.xlsmになります。
 
つきましては、どうしたら良いでしょうか。
 ※大変申し訳ございません。
 
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'*******************************************************************************
' CSVファイルの読み込み処理(FSOのTextStreamを使い、カンマ数に依存しない処理)
'
'*******************************************************************************
Option Explicit
'Private Const CNS_SC = "'" ' シングルクォーテーション
'Private Const CNS_DC = """" ' ダブルクォーテーョン
'Private Const CNS_COMM = "," ' カンマ
'Public Const g_cnsTitle = "ワークシートからMDBへのインポート"
'Const g_cnsMDBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Public g_swOK As Boolean
 
'*******************************************************************************
' CSVファイルの読み込み処理
'*******************************************************************************
Sub 在庫()
    Dim xlAPP As Application
    Dim objFSO As FileSystemObject
    Dim objTS As TextStream
    Dim strFILENAME As String
    Dim vntREC As Variant
    Dim GYO As Long
    Dim COL As Long
    Dim cntREC As Long
    Dim ZR As String
     
    Const STR_SAVE_FilePath = "\\Xc446999p\c446999pn\製造企画室\鈴木\石尾\月末在庫"
    Const STR_SAVE_Filename1 = "検収明細抽出"
    Const STR_SAVE_Filename2 = "ライン別売上(九州)"
    Const STR_SAVE_Filename3 = "ライン別組立重量"
    Const STR_SAVE_Filename4 = "月末在庫"
    Const STR_SAVE_FileFormat = "CSV"
    Dim obj_WB As Workbook, obj_dlWB As Workbook
    Dim lng_EndRow As Long
    Dim obj_ie As Object
    Dim ret As String
    Dim FRngRow As Long
    Dim Lastrow As Long
    'Dim maxDate As Date
     
    Set obj_WB = ThisWorkbook
         
     
     
    '画面更新停止
    Application.Calculation = xlCalculationManual '手動計算
    Application.ScreenUpdating = False '画面がカタカタ動くの停止
     
     
    '確認シート 検収明細抽出 前月明細 G列〜BG列削除
    With obj_WB.Worksheets("確認シート")
        .Range("G:BG").Clear
    End With
     
    '物件完了シート ライン別売上(九州) 前月明細 B列〜AF列削除
    With obj_WB.Worksheets("物件完了")
        .Range("B:AF").Clear
    End With
     
     
    '組立完了シート ライン別組立重量 B列〜P列削除
    With obj_WB.Worksheets("組立完了")
        .Range("B:P").Clear
    End With
     
     
 
    '------CSVのときここから----
    '------検収明細抽出---------
 
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename1 & "." & STR_SAVE_FileFormat)
     
    lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row '20230206
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename1)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1) _
            , Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1) _
            , Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1) _
            , Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1)), TrailingMinusNumbers:=True
         
        'コピー
        '.Range("A:BA").Copy
        .Range("A1:BA" & lng_EndRow).Copy '20230206修正
    End With
     
     
    'ペースト
    With obj_WB.Worksheets("確認シート")
        .Activate
        '.Range("G:G").PasteSpecial Paste:=xlPasteValues
        .Range("G2").PasteSpecial Paste:=xlPasteValues '20230206修正
    End With
     
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
               
           
    '------CSVのときここから-------
    '------ライン別売上(九州)----
     
     
     
   
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename2 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename2)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:O").Copy
    End With
     
      
    'ペースト
    With obj_WB.Worksheets("物件完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
           
               
           
    '------CSVのときここから-----------
    '------ライン別組立重量------------
     
     
     
 
    'ファイルを開く
    Set obj_dlWB = Workbooks.Open(STR_SAVE_FilePath & "\" & STR_SAVE_Filename3 & "." & STR_SAVE_FileFormat)
     
     
    With obj_dlWB.Worksheets(STR_SAVE_Filename3)
        '区切り位置調整
        .Columns("A:A").TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
            (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1) _
            , Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True
         
        'コピー
        .Range("A:AE").Copy
    End With
     
                 
    'ペースト
    With obj_WB.Worksheets("組立完了")
        .Activate
        .Range("B:B").PasteSpecial Paste:=xlPasteValues
    End With
     
    'DLファイルを閉じる
    Application.CutCopyMode = False
    obj_dlWB.Close False
    Set obj_dlWB = Nothing
           
           
    '------CSVのときここまで------
     
     
    '画面更新再開
    Application.Calculation = xlCalculationAutomatic '自動計算
    Application.ScreenUpdating = True '画面がカタカタ動くの再開
     
     
 
End Sub

回答
投稿日時: 23/02/06 12:46:25
投稿者: taitani
投稿者のウェブサイトに移動

引用:
lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row の
Rows.Countは「1058476」になっております。

 
え?
Excel の 最終行は 1048576 ですけど、1058476 になっているんですか?
あと、lng_EndRow と使うのか、lastrow を使うのかどちらですか?
 
コードを理解していない限り、同じような質問のやりとりが続くだけです。

投稿日時: 23/02/06 12:57:53
投稿者: ラブ

お世話になっております。
 
ありがとうございます。
 
Rows.Countは1058476ではなく、1048576でした。すいません。
 ※これはエクセルの数字としては正しいのですね。
 ※ありがとうございます。
 
あと、lng_EndRow と使うのか、lastrow を使うのかどちらですか?
 →どちらを利用しても大丈夫です。
  ただ、最初lng_EndRowを使っていたので、lng_EndRowを使うのが正なのかなと思っています。
 
 
理解していなくて、大変申し訳ございません。

回答
投稿日時: 23/02/06 13:16:20
投稿者: taitani
投稿者のウェブサイトに移動

引用:
実行時エラー9
こちらの様に修正してみたのですが、インデックスが有効範囲にありません。
  
と、lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row '20230206
で、表示されます。
  
lng_EndRow = obj_dlWB.Worksheets("確認シート").Cells(Rows.Count, 1).End(xlUp).Row の
Rows.Countは「1058476」になっております。

 
「インデックスが有効範囲にありません。」なのに、Rows.Count に代入されているのは矛盾していますね。
 
例えば、確認シート じゃなくて、「確認シート」だったりします?

投稿日時: 23/02/06 13:54:46
投稿者: ラブ

お世話になっております。
 
すいません。ありがとうございます。
 
"確認シート"は出力先のエクセルのシート名でした。
正しくは、抽出元のCSV"検収明細抽出"でした。
 
"検収明細抽出"に変更したら、無事にG2列からCSVデータが出力されました。
 
本当によくわかっていなくて、申し訳ございませんでした。
 
taitani様
simple様
 
 色々とありがとうございました。