Excel VBA質問箱 IV

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

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


60797 / 76732 ←次へ | 前へ→

【20569】Re:重複データの整理について
回答  [名前なし]  - 04/12/12(日) 12:46 -

引用なし
パスワード
   ▼m3 さん:
>最後に一つだけ質問させてください。
>テキストファイルから("日付", "個人ID", "出勤時間", "退勤時間")を
>毎日取り込む場合、新しいデータを
>例えばA1を起点に挿入し、ダウンシフトするものと思います。
>恐らく Range("A2").Insert Shift:=xlDown になると思います。
>マクロのどの部分で設定すればよいでしょうか?
>なかなか上手くいきません。
「途中に追加」ではなく「最下行に追加」のほうがいいと思います。
下のコードをご覧ください。
最新のものを上のほうに持ってきたいのであれば、一番最後の並べ替えで
日付を降順にすればよいでしょう。降順の指定は、マクロの記録で調べるか、
ヘルプをご覧ください。

>また、誤って同じデータを挿入した場合を考え
>重複データの削除設定も行いたいのですが、
>これは、1行下のデータが同じ場合、1行下を削除する。
>を最後に指定すればよいでしょうか?
その前に、「同じデータを取り込まないようにする」ほうがいいでしょう。(※)
例えば、取り込み済みのデータのテキストファイルを
(1)名前を変更する。(XXX.CSV→済XXX.CSV)
(2)保存先を変更する。(C:\XXX→C:\XXX\処理済)
(3)取り込んだら別シートに取り込んだデータファイル名を追加し、
 そこにファイル名が無いものだけ取り込む。

などなど。どれか1つでいいと思います。下のコードをご覧ください。
でも、実際のファイル名がどうなってるかわからないので、なんとも言えませんが。

>Sub 勤怠3()
>  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
   '(3)の場合はここに(※)の処理。
>
>  intFF = FreeFile
>  Open strFILENAME For Input As #intFF
  'GYO = 1 ←を下のように変更し、最下行にするようにします。
   GYO = Cells(Cells.Rows.Count, 1).End(xlUp).Row
>  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
   '(1)または(2)の場合はここに(※)の処理。
>  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, 4).Activate 'D列を参照する
>    'D列が空白で、日付・個人IDが下の行と同じなら
>    If ActiveCell.Value = "" And _
>    ActiveCell.Offset(0, -3).Value = ActiveCell.Offset(1, -3).Value And _
>    ActiveCell.Offset(0, -2).Value = ActiveCell.Offset(1, -2).Value Then
>      ActiveCell.Value = ActiveCell.Offset(1, 0).Text '下の退勤時間を書き込む
>      ActiveCell.Offset(1, 0).EntireRow.Delete Shift:=xlUp '1行下を削除
>    End If
>  Next
>  Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Header:=xlGuess
>
>
>End Sub
0 hits

【20493】重複データの整理について m3 04/12/10(金) 13:58 質問
【20517】Re:重複データの整理について [名前なし] 04/12/10(金) 22:11 回答
【20542】Re:重複データの整理について m3 04/12/11(土) 20:36 質問
【20545】Re:重複データの整理について [名前なし] 04/12/11(土) 21:20 発言
【20548】Re:重複データの整理について m3 04/12/11(土) 22:39 質問
【20550】Re:重複データの整理について [名前なし] 04/12/11(土) 23:01 発言
【20552】Re:重複データの整理について m3 04/12/11(土) 23:08 質問
【20554】Re:重複データの整理について m3 04/12/11(土) 23:34 発言
【20555】Re:重複データの整理について [名前なし] 04/12/11(土) 23:40 回答
【20556】Re:重複データの整理について m3 04/12/12(日) 0:46 お礼
【20567】Re:重複データの整理について m3 04/12/12(日) 12:02 質問
【20569】Re:重複データの整理について [名前なし] 04/12/12(日) 12:46 回答
【20570】Re:重複データの整理について m3 04/12/12(日) 14:46 お礼
【20571】Re:重複データの整理について [名前なし] 04/12/12(日) 14:52 発言
【20584】Re:重複データの整理について m3 04/12/12(日) 22:02 質問
【20585】Re:重複データの整理について [名前なし] 04/12/12(日) 23:10 回答
【20589】Re:重複データの整理について m3 04/12/13(月) 0:23 質問
【20592】Re:重複データの整理について [名前なし] 04/12/13(月) 1:02 回答
【20593】Re:重複データの整理について m3 04/12/13(月) 1:16 お礼
【20598】Re:重複データの整理について Jaka 04/12/13(月) 9:11 回答

60797 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free