Excel VBA質問箱 IV

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

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


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

60854 / 76738

←次へ　｜　前へ→


	【20517】Re:重複データの整理について

[名前なし] - 04/12/10(金) 22:11 -


	引用なし

	パスワード

>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セルへ
　　 Cells(GYO, X(3) + 2) = Format(X(2), "00:00")　　'第2項目をB3 or B4セルへ
>　　Cells(GYO, 2) = X(4)　　　　　　 '第4項目をB2セルへ
>　　　
>　　Loop
>　　' 指定ﾌｧｲﾙをCLOSE
>　　Close #intFF
>　　xlAPP.StatusBar = False
>　　' 終了の表示
　　Range("A1:D1").Value = Array("日付", "個人ID", "出勤時間", "退勤時間")
>　　MsgBox "ファイル読み込みが完了しました。" & vbCr & _
>　　　　"レコード件数=" & lngREC & "件", vbInformation, cnsTITLE
　　Range("A1").CurrentRegion.Sort Key1:=Range("B1"), Header:=xlGuess
　　Range("D2").Delete Shift:=xlUp
　　For lngCnt = Cells(Cells.Rows.Count, 1).End(xlUp).Row To 2 Step -1
　　　　Cells(lngCnt, 1).Activate
　　　　If ActiveCell.Offset(0, 2).Value = "" Then
　　　　　　ActiveCell.EntireRow.Delete Shift:=xlUp
　　　　End If
　　Next
>End Sub

でどうでしょうか。

0 hits

▼

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