Excel VBA質問箱 IV

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

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


39099 / 76732 ←次へ | 前へ→

【42752】Re:重複値を、別ブックに書き出したい
回答  Kein  - 06/9/20(水) 17:06 -

引用なし
パスワード
   ユーザーフォームを使わないコードです。このまま試してみて下さい。

Sub Fields_Check()
  Dim MyF As String, TbN As String
  Dim NewB As String, Buf As String
  Dim Ary As Variant
  Dim WB As Workbook
  Dim MyR As Range
 
  MyF = Application _
  .GetOpenFilename("CSVファイル(*.csv),*.csv")
  If MyF = "False" Then Exit Sub
  TbN = Left$(Dir(MyF), Len(Dir(MyF)) - 4)
  NewB = CurDir() & "\" & TbN & _
  Format(Date, "yymmdd") & ".xls"
  If Dir(NewB) <> "" Then
   MsgBox "本日のファイルは作成済みです", 48: Exit Sub
  End If
  Open MyF For Input Access Read As #1
  Line Input #1, Buf
  Close #1: Ary = Split(Buf, ",")
  Application.ScreenUpdating = False
  Set WB = Workbooks.Add(xlWBATWorksheet)
  With WB.Worksheets(1)
   .Range("A1:B1").Value = Array("重複項目", "列番号")
   Set MyR = .Range("A2").Resize(UBound(Ary) + 1)
   MyR.Value = WorksheetFunction.Transpose(Ary)
   With .Range("B2")
     .Value = 1: .AutoFill MyR.Offset(, 1), xlLinearTrend
   End With
   On Error Resume Next
   With MyR.Offset(, 255)
     .Formula = "=IF(COUNTIF($A:$A,$A2)=1,1)"
     .SpecialCells(3, 1).EntireRow.Delete xlShiftUp
     .ClearContents
   End With
   On Error GoTo 0
   .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
   Order1:=xlAscending, Key2:=.Range("B1"), Order2:= _
   xlAscending, Header:=xlYes, Orientation:=xlSortColumns
   .Name = TbN
  End With
  WB.SaveAs NewB: Set WB = Nothing: Set MyR = Nothing
  Application.ScreenUpdating = True
End Sub
1 hits

【42748】重複値を、別ブックに書き出したい Palmer 06/9/20(水) 14:49 質問
【42751】Re:重複値を、別ブックに書き出したい ハチ 06/9/20(水) 16:05 発言
【42753】Re:重複値を、別ブックに書き出したい Palmer 06/9/20(水) 17:15 お礼
【42752】Re:重複値を、別ブックに書き出したい Kein 06/9/20(水) 17:06 回答
【42755】Re:重複値を、別ブックに書き出したい Palmer 06/9/20(水) 17:17 お礼

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