Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

60871 / 76732

←次へ　｜　前へ→


	【20493】重複データの整理について

ｍ3 - 04/12/10(金) 13:58 -


	引用なし

	パスワード

下記は勤怠管理のテキストデータになります。
左から日付,時間,種別(1：出勤、2：退勤),個人IDです。
20041207,0800,1,12011013
20041207,0802,1,12011005
20041207,0802,1,12011007
20041207,0805,1,12011010
20041207,0808,1,12013001
20041207,0813,1,12013003
20041207,1733,2,12011010
20041207,1734,2,12011013
20041207,1734,2,12011005
20041207,1734,2,12011007
20041207,1734,2,12013003
20041207,1735,2,12013001

これを
日付,個人ID,出勤時間,退勤時間へと編集したく思います。
（例：20041207　12011013　08:00　17:34）

下記内容で退勤時間のセルの移動までできました。
この後、どの様に組めばよいでしょうか？

Sub 勤怠2()
　　Const cnsTITLE = "テキストファイル読み込み処理"
　　Const cnsFILTER = "全てのファイル (*.*),*.*"
　　Dim xlAPP As Application　　　　' Applicationｵﾌﾞｼﾞｪｸﾄ
　　Dim intFF As Integer　　　　　　' FreeFile値
　　Dim strFILENAME As String　　　 ' OPENするﾌｧｲﾙ名(ﾌﾙﾊﾟｽ)
　　Dim X(1 To 4) As Variant　　　　' 読み込んだﾚｺｰﾄﾞ内容
　　Dim GYO As Long　　　　　　　　 ' 収容するｾﾙの行
　　Dim lngREC As Long　　　　　　　' ﾚｺｰﾄﾞ件数ｶｳﾝﾀ
　　
　　Set xlAPP = Application
　　xlAPP.StatusBar = "読み込むファイル名を指定して下さい。"
　　strFILENAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _
　　　　Title:=cnsTITLE)
　　If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub
　　
　　intFF = FreeFile
　　Open strFILENAME For Input As #intFF
　　GYO = 1
　　Do Until EOF(intFF)
　　　　lngREC = lngREC + 1
　　　　xlAPP.StatusBar = "読み込み中です．．．．(" & lngREC & "レコード目)"
　　　　Input #intFF, X(1), X(2), X(3), X(4)
　　　　GYO = GYO + 1
　　
　　Cells(GYO, 1) = X(1)　　　　　　 '第1項目をB1セルへ
　　If X(3) = 1 Then
　　　 Cells(GYO, 3) = X(2)　　　　　'第2項目をB3セルへ
　　　 Else
　　　 Cells(GYO, 4) = X(2)　　　　 '第2項目をB4セルへ
　　　 End If
　　Cells(GYO, 2) = X(4)　　　　　　 '第4項目をB2セルへ
　　　
　　Loop
　　' 指定ﾌｧｲﾙをCLOSE
　　Close #intFF
　　xlAPP.StatusBar = False
　　' 終了の表示
　　MsgBox "ファイル読み込みが完了しました。" & vbCr & _
　　　　"レコード件数=" & lngREC & "件", vbInformation, cnsTITLE
End Sub

1 hits

▼

【20493】重複データの整理について ｍ3 04/12/10(金) 13:58

≪