質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

2回答

1440閲覧

VBAでデータを別シートにコピーさせ加工をする

padnndada

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/05/18 10:00

前提・実現したいこと

CSVデータを取り込み、取り込んだデータを定義したシートにコピーするプログラムを考えています。
bookにはそれぞれ、メニュー・エクスポート・設定・実行結果のシートがあります。
メニューシート・・・ボタンを設置
エクスポートシート・・・csvで取り込んだデータをただ貼り付けているシート
設定シート・・・実行結果で1行目に出力される項目
実行結果シート・・・ボタン実行後シートが作成される(1行目に設定シートの1行目が出力されるように)

実現したいこと
・番号の列のデータを別シートのidの列に入れたい
・時間データを[h]mm:ssに変換したい
・時間の合計を算出し次の月のデータを繰り返す

よろしくお願いいたします。

発生している問題

取り込むデータは下記

番号,氏名,勤務月,勤務時間, 56,田中花子,5月,11:22, 56,田中花子,6月,34:22:00, 56,田中花子,7月,22:00,

設定シートの1行目は
イメージ説明

だった時、実行結果のシートに以下のような出力結果が出るVBAを考えています。
イメージ説明

該当のソースコード

Sub Csv_test() Dim A_Sheet Dim Csv_Import_File A_Sheet = ActiveSheet.Name Csv_Import_File = Application.GetOpenFilename("CSVファイル,*.csv") If Csv_Import_File = "False" Then Exit Sub ThisWorkbook.Sheets("抽出データ").Range("A1:ZZ100000").ClearContents With Workbooks.Open(Csv_Import_File) .Sheets(1).Cells.Copy ThisWorkbook.Sheets("抽出データ").Range("A1") .Close End With Worksheets(A_Sheet).Activate Worksheets("定義データ").Rows(1).Copy Worksheets("実行結果").Rows(1).PasteSpecial (xlPasteAll) End Sub

補足情報

Excel2013

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

meg_

2020/05/18 10:10

・質問文中のシート名とコード中のシート名が異なっていてよく分かりません。 ・現状はどこまでできているのでしょうか?
padnndada

2020/05/18 10:47

メニューシート・・・ボタンを設置 抽出データシート・・・csvで取り込んだデータをただ貼り付けているシート 定義データシート・・・実行結果で1行目に出力される項目 実行結果シート・・・ボタン実行後シートが作成される(1行目に設定シートの1行目が出力されるように) でした。大変失礼いたしました。 現状は、csvのデータを抽出データシートに貼り付け、定義データの1行目を実行結果シートに貼り付けまでできています。
meg_

2020/05/18 13:01

質問のコードについて、CSVファイルを開いていません。開いてそのデータをコピーしましょう。
guest

回答2

0

ExcelVBA

1Sub Macro1() 2 Dim vFName As Variant 3 Dim rngTop As Range 4 Dim rngBottom As Range 5 6 vFName = Application.GetOpenFilename("CSVファイル,*.csv") 7 If vFName = False Then Exit Sub 8 9 Set rngTop = ThisWorkbook.Sheets("実行結果").Range("C4") 10 11 With rngTop 12 With .Worksheet.QueryTables.Add(Connection:="TEXT;" & vFName, Destination:=.Cells) 13 .TextFileStartRow = 2 ' 2 行目から読み込み 14 .TextFilePlatform = 932 ' 文字コードを指定 15 .TextFileParseType = xlDelimited ' 区切り文字の形式 16 .TextFileCommaDelimiter = True ' カンマ区切り 17 .RefreshStyle = xlOverwriteCells ' セルに上書き 18 .Refresh ' データを表示 19 .Delete ' CSV との接続を解除 20 End With 21 Set rngBottom = .End(xlDown) 22 End With 23 24 With Application.Range(rngTop, rngBottom) 25 .Columns("D:E").NumberFormatLocal = "[h]:mm:ss" 26 With .Columns("E") 27 .FormulaR1C1 = "=sum(r[0]c[-1],r[-1]c[0])" 28 .Value = .Value 29 End With 30 End With 31End Sub

テキストデータのインポートの機能を使えば、余分なシートを汚さなくてもいいかと思います。
マクロの記録をしてみればコードが得られます。

投稿2020/05/22 02:56

mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

サンプル作成して見ました。時間部分は文字列にしています。
日時計算は何時も難しい課題になると思われます

Option Explicit '-------------------------------------------- ’(Test_Sample_Miniature) '対象データ領域は("A2:A100")部分を変更 '-------------------------------------------- ' ■■定義追加部分■■■ '-------------------------------------------- Public glngHH As Long Public glngMM As Long Public glngSS As Long Public glngRowCount As Long Public grng番号 As Range Public grng氏名 As Range Public grng何月 As Range '-------------------------------------------- Sub Test_Sample_Miniature() Dim A_Sheet Dim Csv_Import_File A_Sheet = ActiveSheet.Name Csv_Import_File = Application.GetOpenFilename("CSVファイル,*.csv") If Csv_Import_File = "False" Then Exit Sub ThisWorkbook.Sheets("抽出データ").Range("A1:ZZ100000").ClearContents With Workbooks.Open(Csv_Import_File) .Sheets(1).Cells.Copy ThisWorkbook.Sheets("抽出データ").Range("A1") .Close End With Worksheets(A_Sheet).Activate Worksheets("定義データ").Rows(1).Copy Worksheets("実行結果").Rows(1).PasteSpecial (xlPasteAll) '-------------------------------------------- ' ■■以下追加部分■■■ '-------------------------------------------- Dim strTime As String Dim lngHH As Long Dim lngMM As Long Dim lngSS As Long Dim MyRange As Range Dim lngSta As Long Dim lngEnd As Long Dim strCheckTime As String glngHH = 0 glngMM = 0 glngSS = 0 glngRowCount = 1 For Each MyRange In Sheets("抽出データ").Range("A2:A100") ' If Trim(MyRange) = "" Then Exit Sub strTime = Cells(MyRange.Row, 4).Text lngSta = InStr(strTime, ":") lngEnd = InStr(lngSta + 1, strTime, ":") ' If lngSta <> 0 Then '時間: strCheckTime = Left(strTime, InStr(strTime, ":") - 1) If IsNumeric(strCheckTime) = True Then lngHH = CLng(strCheckTime) Else MsgBox "Error:TimeData" Exit For End If ' If lngEnd <> 0 Then '分:秒 strCheckTime = Mid(strTime, lngSta + 1, (lngEnd - lngSta - 1)) If IsNumeric(strCheckTime) = True Then lngMM = CLng(strCheckTime) Else MsgBox "Error:TimeData" Exit For End If strCheckTime = Mid(strTime, lngEnd + 1) If IsNumeric(strCheckTime) = True Then lngSS = CLng(strCheckTime) Else MsgBox "Error:TimeData" Exit For End If Else '分 strCheckTime = Mid(strTime, lngSta + 1) If IsNumeric(strCheckTime) = True Then lngMM = CLng(strCheckTime) Else MsgBox "Error:TimeData" Exit For End If End If Else '時間 If IsNumeric(strTime) = True Then lngHH = CLng(strTime) Else MsgBox "Error:TimeData" Exit For End If End If ' '書込み時刻編集 '(秒) Do Until lngSS <= 59 lngMM = lngMM + 1 lngSS = lngSS - 60 Loop '(分) Do Until lngMM <= 59 lngHH = lngHH + 1 lngMM = lngMM - 60 Loop ' Set grng番号 = Sheets("抽出データ").Cells(MyRange.Row, 1) Set grng氏名 = Sheets("抽出データ").Cells(MyRange.Row, 2) Set grng何月 = Sheets("抽出データ").Cells(MyRange.Row, 3) strTime = "'" & Format(lngHH, "00") & ":" & Format(lngMM, "00") & ":" & Format(lngSS, "00") 'Debug.Print strTime Call Write_Process(grng番号, grng氏名, grng何月, lngHH, lngMM, lngSS, strTime) ' Next 'オブジェクト解放 Set grng番号 = Nothing Set grng氏名 = Nothing Set grng何月 = Nothing End Sub Function Write_Process( _ ByRef rng番号 As Range, _ ByRef rng氏名 As Range, _ ByRef rng何月 As Range, _ ByRef lngPraHH As Long, _ ByRef lngPraMM As Long, _ ByRef lngPraSS As Long, _ ByRef strPra時間 As String) Dim lngHH As Long Dim lngMM As Long Dim lngSS As Long Dim strTime As String Dim Sh As Worksheet Set Sh = Sheets("実行結果") ' '時刻加算 glngHH = glngHH + lngPraHH glngMM = glngMM + lngPraMM glngSS = glngSS + lngPraSS ' lngHH = glngHH lngMM = glngMM lngSS = glngSS ' '書込み時刻編集 '(秒) Do Until lngSS <= 59 lngMM = lngMM + 1 lngSS = lngSS - 60 Loop '(分) Do Until lngMM <= 59 lngHH = lngHH + 1 lngMM = lngMM - 60 Loop strTime = "'" & Format(lngHH, "00") & ":" & Format(lngMM, "00") & ":" & Format(lngSS, "00") ' '最終書込み glngRowCount = glngRowCount + 1 ' Sh.Cells(rng番号.Row, rng番号.Column) = rng番号 Sh.Cells(rng氏名.Row, rng氏名.Column) = rng氏名 Sh.Cells(rng何月.Row, rng何月.Column) = rng何月 Sh.Cells(rng何月.Row, rng何月.Column + 1) = strPra時間 Sh.Cells(rng何月.Row, rng何月.Column + 2) = strTime ' '解放 Set Sh = Nothing End Function

投稿2020/05/22 01:18

編集2020/05/22 20:10
tosi

総合スコア553

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問