Ｐａｇｅ 373 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼違う場所にあるシートのｃｏｐｙ KUＭＩ 02/11/20(水) 16:55 ┣Re:違う場所にあるシートのｃｏｐｙ でん 02/11/20(水) 17:25 ┃ ┗Re:違う場所にあるシートのｃｏｐｙ KUＭＩ 02/11/20(水) 17:43 ┃ ┗Re:違う場所にあるシートのｃｏｐｙ KUＭＩ 02/11/20(水) 17:51 ┃ ┗Re:違う場所にあるシートのｃｏｐｙ でん 02/11/20(水) 18:21 ┗Re:違う場所にあるシートのｃｏｐｙ Jaka 02/11/21(木) 9:03 ┣CSVファイル読み込むなら。 おまけ Jaka 02/11/21(木) 10:55 ┃ ┗一部修正。 Jaka 02/11/21(木) 11:11 ┗Re:違う場所にあるシートのｃｏｐｙ でん 02/11/21(木) 11:14 ┗Re:違う場所にあるシートのｃｏｐｙ KUＭＩ 02/11/21(木) 16:53 ─────────────────────────────────────── ■題名 ： 違う場所にあるシートのｃｏｐｙ ■名前 ： KUＭＩ ■日付 ： 02/11/20(水) 16:55 -------------------------------------------------------------------------
| 現在シートMYLOGが開いている状態で、コマンドボタンを押すと、 C:\PRIVATEにあるTEST.csvを読み込んで、MYLOGに貼り付けるという 作業を行うために、下記のようなソースを作りましたが、エラーになってしまいます。 どこを直せばよいのでしょうか。 Workbooks.Open Filename:= _ "C:\PRIVATE\TEST.csv" Range("A1:B288").Select Selection.Copy Windows("MYLOG.xls").Activate Range("A6").Select Sheets("MYLOG.xls").Paste Windows("TEST.csv").Activate ActiveWindow.Close |
| ▼KUＭＩ さん： こんにちわ >Sheets("MYLOG.xls").Paste ってところを ActiveSheet.Paste に直すってのでどうでしょう？ では。 |
| ▼でん さん： ありがとうございます 直してみましたが、 ｢アプリケーション定義またはオブジェクト定義のエラーです」 と出てきてしまいます。 >▼KUＭＩ さん： >こんにちわ > >>Sheets("MYLOG.xls").Paste >ってところを >ActiveSheet.Paste >に直すってのでどうでしょう？ > >では。 |
| すみません。 私がTESTのシートを立ち上げていたからエラーメッセージが 出たみたいです。 今度は、コマンドボタンを押しても何も反応しなくなってしまいました・・・。 >▼でん さん： >ありがとうございます > >直してみましたが、 >｢アプリケーション定義またはオブジェクト定義のエラーです」 >と出てきてしまいます。 > > >>▼KUＭＩ さん： >>こんにちわ >> >>>Sheets("MYLOG.xls").Paste >>ってところを >>ActiveSheet.Paste >>に直すってのでどうでしょう？ >> >>では。 |
| ▼KUＭＩ さん： こんばんわ。 >私がTESTのシートを立ち上げていたからエラーメッセージが >出たみたいです。 ん？私のところはTEST.csvを立ち上げていても実行できたんですが・・・。 >今度は、コマンドボタンを押しても何も反応しなくなってしまいました・・・。 んんっ？ボタン・・・。 マクロの登録出来てますよね？ ボタンの上でマウスカーソルは指カーソルに変わりますよね？ 私のとこでは全て旨くいったのですが・・・。 こちらは、OS:Windows xp Excel:2000 です。 |
| おはようございます。 Workbooks.Open Filename:="C:\PRIVATE\TEST.csv" Range("A1:B288").Copy ThisWorkbook.Sheets("Sheet1").Range("A6") Workbooks("TEST.csv").Close もう１個別物 Dim CopyBook As Workbook Set CopyBook = Workbooks.Open("C:\PRIVATE\TEST.csv") CopyBook.Worksheets("TEST").Range("A1:B288").Copy _ ThisWorkbook.Sheets("Sheet1").Range("A6") CopyBook.Close Set CopyBook = Nothing |
| あまり速くないけど。 Option Base 1 Sub CSVファイル読込TBL使用() Dim シート名 As String, 基シート名 As String, 処理CNT As Long, CSV全データ行数 As Long Dim 書始め行 As Long, 増シート数 As Integer, 行 As Long, 列位置 As Integer Dim TBL() As String, カンマ数 As Integer, TBL行数 As Long, TBL行CNT As Long, 拡張子 As String Dim ReadDete As String, 設定行 As Integer, 設定列 As Integer, バーお知らせ As String Dim 基本TBL行数 As Long, 使用TBL行数 As Long, 終了flg As Integer, 改シート行flg As Integer Dim 書込み最終行設定 As Long, 書込み有効残数 As Long, シート最終行入力 As String, 追加枚数 As Integer Dim 振分け As Variant, 振分け2 As Variant, STime As Variant, ETime As Variant Dim I As Long, WクォFlg As Byte 基シート名 = ActiveSheet.Name シート名 = 基シート名: 増シート数 = 0: 改シート行flg = 0 CSV全データ行数 = 0: バーお知らせ = "行目から ": 終了flg = 0: カンマ数 = 0 基本TBL行数 = 1000: TBL行CNT = 0: 処理CNT = 0: 改シートflg = 0: WクォFlg = 0 'On Error Resume Next オープンファイル = Application.GetOpenFilename("Excelファイル (*.csv;*.txt), *.csv;*.txt") If オープンファイル <> False Then 拡張子 = StrConv(Right(オープンファイル, 3), vbUpperCase) Open オープンファイル For Input As #1 Else End End If '書込み形式入力 Line Input #1, ReadDete 振分け = MsgBox(拡張子 & "ファイルをカンマ区切りでセルに振分けますか？" & vbCrLf & vbCrLf & _ "振分けずに1列に読込むなら「いいえ」を。" & vbCrLf & vbCrLf & _ "中止するならキャンセルを選択してください。", vbQuestion + vbYesNoCancel, 拡張子 & _ "ファイル読込形式") If 振分け = vbYes Then For I = 1 To Len(ReadDete) If Mid(ReadDete, I, 1) = "," And WクォFlg = 0 Then カンマ数 = カンマ数 + 1 ElseIf Mid(ReadDete, I, 1) = Chr(34) And WクォFlg = 0 Then WクォFlg = 1 ElseIf Mid(ReadDete, I, 1) = Chr(34) And WクォFlg = 1 Then WクォFlg = 0 End If Next If カンマ数 = 0 Then 振分け2 = MsgBox("１行目データを見た所、区切りのカンマが全くありません。" & Chr(13) & _ "強行しますか？", vbExclamation + vbYesNo, "カンマエラー") If 振分け2 = vbNo Then Close #1 End End If End If ElseIf 振分け = vbNo Then 基本TBL行数 = 15000 Else Close #1 End End If Close #1 ReadDete = Empty Set myShape1 = ActiveSheet.Shapes.AddTextEffect(msoTextEffect11, _ "現在、" & 拡張子 & "全データ行数を" & vbCrLf & "カウントしています。 ", _ "ＭＳ ゴシック", 28, msoFalse, msoFalse, 120, 100) DoEvents DoEvents Open オープンファイル For Input As #1 Do Until EOF(1) Line Input #1, ReadDete CSV全データ行数 = CSV全データ行数 + 1 Loop Close #1 'Application.DisplayStatusBar = False myShape1.Delete Set myShape1 = Nothing DoEvents 'シート最終行（改ページ行）入力 書込み最終行設定 = Cells(Rows.Count, 1).Row Do シート最終行入力 = Application.InputBox(Prompt:=拡張子 & "全データ行数は、" & CSV全データ行数 & "行有りました。" & _ vbCrLf & vbCrLf & "書込み最終行（改ページ行）を入力して下さい。", _ Title:="書込み最終行（改ページ行）入力", Default:=書込み最終行設定) If シート最終行入力 = "False" Then End ElseIf Not (IsNumeric(シート最終行入力)) Then MsgBox "数字を入力して下さい。", vbExclamation, "入力エラー" ElseIf シート最終行入力 < 1 Or シート最終行入力 > 書込み最終行設定 Then MsgBox "最終行（改ページ行）は、1〜" & 書込み最終行設定 & "の間までです。", vbExclamation, "入力エラー" Else 書込み最終行設定 = Int(シート最終行入力) Exit Do End If Loop Do Call 書込み開始位置設定(設定行, 設定列) If 設定行 > 書込み最終行設定 Then MsgBox "書込み最終行（改ページ行）" & "行より下行を" & vbCrLf & _ "書込み開始行とすることはできません。", vbExclamation, "開始位置設定エラー" ElseIf CSV全データ行数 / (書込み最終行設定 - (設定行 - 1)) + Worksheets.Count - 1 > 50 Then 追加枚数 = CSV全データ行数 / (書込み最終行設定 - (設定行 - 1)) - 1 中止有無 = MsgBox("現在のシート枚数 " & Worksheets.Count & " 枚、追加されるシート枚数 " & 追加枚数 & " 枚。" & vbCrLf & _ vbCrLf & "全シート枚数が50枚を超えます。" & vbCrLf & vbCrLf & "書き始め行と書込み最終行（改シート行）を設定を変えますか？" & _ vbCrLf & vbCrLf & "見なおす場合は、一旦終了します。", vbExclamation + vbYesNo, "シート追加枚数警報") If 中止有無 = vbYes Then End Else Exit Do End If Else Exit Do End If Loop 書始め行 = 設定行 行 = 書始め行 書始め列 = 設定列 '初期TBL行数設定 書込み有効残数 = 書込み最終行設定 - (書始め行 - 1) If 書込み有効残数 < 基本TBL行数 Then 基本TBL行数 = 書込み有効残数 ElseIf CSV全データ行数 <= 基本TBL行数 Then 基本TBL行数 = CSV全データ行数 終了flg = 1 End If TBL行数 = 基本TBL行数 ReDim TBL(TBL行数, カンマ数 + 1) Application.DisplayStatusBar = True 'Application.ScreenUpdating = False Application.Calculation = xlManual STime = Now() Open オープンファイル For Input As #1 Do Until EOF(1) 処理CNT = 処理CNT + 1 TBL行CNT = TBL行CNT + 1 Application.StatusBar = 拡張子 & "全データ " & CSV全データ行数 & "行中、" & Format(処理CNT, "000000") & "行目読込み中" If カンマ数 = 0 Then Line Input #1, TBL(TBL行CNT, カンマ数 + 1) Else For I = 1 To カンマ数 + 1 Input #1, TBL(TBL行CNT, I) Next End If If TBL行CNT = TBL行数 Or EOF(1) Then Application.StatusBar = 拡張子 & "全データ " & CSV全データ行数 & "行中、" & Format(処理CNT, "000000") & "行目読込み後、" & _ シート名 & "に " & 行 & バーお知らせ & TBL行数 & "行の書込み中" ActiveWorkbook.Worksheets(シート名).Range(Cells(行, 書始め列), Cells(行 + TBL行数 - 1, 書始め列 + カンマ数)).Value = TBL DoEvents TBL行CNT = 0 行 = 行 + TBL行数 書込み有効残数 = 書込み有効残数 - TBL行数 If 終了flg = 1 Then Exit Do End If If CSV全データ行数 - 処理CNT > 0 Then '改ページ If 書込み有効残数 = 0 Then Call TBL使用シート増(基シート名, シート名, 増シート数, 設定行, 設定列) DoEvents 行 = 書始め行 書込み有効残数 = 書込み最終行設定 - (書始め行 - 1) If CSV全データ行数 - 処理CNT < TBL行数 Then TBL行数 = CSV全データ行数 - 処理CNT Else TBL行数 = 基本TBL行数 End If ElseIf 書込み有効残数 < TBL行数 Then TBL行数 = 書込み有効残数 ElseIf CSV全データ行数 - 処理CNT < TBL行数 Then TBL行数 = CSV全データ行数 - 処理CNT Else TBL行数 = 基本TBL行数 End If Else 終了flg = 1 End If ReDim TBL(TBL行数, カンマ数 + 1) End If Loop Close #1 Erase TBL ETime = Now() 'Application.ScreenUpdating = True Application.Calculation = xlAutomatic DoEvents Set myShape2 = ActiveSheet.Shapes.AddTextEffect(msoTextEffect11, _ "処理終了しました ", "ＭＳ ゴシック", 48, msoFalse, msoFalse, 120, 100) Application.StatusBar = 拡張子 & "全データ " & CSV全データ行数 & "行中、" & Format(処理CNT, "000000") & "行の処理終了しました。" 終了ボックス.Show myShape2.Delete Set myShape2 = Nothing Application.DisplayStatusBar = False MsgBox "TBL行数" & 基本TBL行数 & vbCrLf & STime & "-" & ETime & "=" & Format(ETime - STime, "hh:mm:ss") End End Sub Sub TBL使用シート増(基シート名 As String, シート名 As String, 増シート数 As Integer, 設定行 As Integer, 設定列 As Integer) Dim 使用列数 As Integer, RR As Integer, II As Integer 使用列数 = Sheets(基シート名).UsedRange.Columns.Count For II = 1 To Worksheets.Count If ActiveSheet.Name = Worksheets(II).Name Then On Error Resume Next 増シート数 = 増シート数 + 1 Worksheets.Add after:=Worksheets(II) ActiveSheet.Name = 基シート名 & "_" & 増シート数 シート名 = Worksheets(II + 1).Name Application.ScreenUpdating = False For RR = 1 To 使用列数 With Sheets(シート名) .Columns(RR).NumberFormatLocal = Sheets(基シート名).Columns(RR).NumberFormatLocal .Columns(RR).ColumnWidth = Sheets(基シート名).Columns(RR).ColumnWidth End With Next Application.ScreenUpdating = True Worksheets(シート名).Select Exit Sub End If Next End Sub Function 書込み開始位置設定(設定行, 設定列) As Integer Dim エラー番号 As Integer Dim 入力始点位置set As Object On Error Resume Next Set 入力始点位置set = Application.InputBox(Prompt:="書込む最初のセルをクリックして下さい。", _ Title:="書込み位置の選択", Default:=ActiveCell.Address, Type:=8) If 入力始点位置set Is Nothing Then 入力始点位置set = Nothing End Else 設定行 = 入力始点位置set.Row 設定列 = 入力始点位置set.Column End If 入力始点位置set = Nothing End Function |
| 直してね。 終了ボックス.Show ↓ MsgBox "クリックして下さい。", vbInformation, "マクロ終了" |
| ▼Jaka さん： こんにちわ。 ありがとうございます。 > Workbooks.Open Filename:="C:\PRIVATE\TEST.csv" > Range("A1:B288").Copy ThisWorkbook.Sheets("Sheet1").Range("A6") > Workbooks("TEST.csv").Close > > >もう１個別物 > > Dim CopyBook As Workbook > Set CopyBook = Workbooks.Open("C:\PRIVATE\TEST.csv") > CopyBook.Worksheets("TEST").Range("A1:B288").Copy _ > ThisWorkbook.Sheets("Sheet1").Range("A6") > CopyBook.Close > Set CopyBook = Nothing 初心者なんで勉強になるです。 頑張りまっす！ |
| でんさん、ｊａｋａさん、どうもありがとうございます。 コマンドボタンのPRIVATE SUBを辞めて、ボタンにしたら うまくいきました！ 私も初心者なので、JAKAさんのも参考になりました！ ▼でん さん： >▼Jaka さん： >こんにちわ。 >ありがとうございます。 > >> Workbooks.Open Filename:="C:\PRIVATE\TEST.csv" >> Range("A1:B288").Copy ThisWorkbook.Sheets("Sheet1").Range("A6") >> Workbooks("TEST.csv").Close >> >> >>もう１個別物 >> >> Dim CopyBook As Workbook >> Set CopyBook = Workbooks.Open("C:\PRIVATE\TEST.csv") >> CopyBook.Worksheets("TEST").Range("A1:B288").Copy _ >> ThisWorkbook.Sheets("Sheet1").Range("A6") >> CopyBook.Close >> Set CopyBook = Nothing > >初心者なんで勉強になるです。 >頑張りまっす！ |