人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です。
c:\test\のホルダーにCSVファイルが複数あります。
F列にあるデータに数字で1、2、3、4、5、6、7、8、9、10、11、12、以外にある
文字、数字、空白がある行のデータを削除するマクロをお願いします。
データ列はA2からS2まであります
A1は項目行です

結果F列には数字の1、2、3、4、5、6、7、8、9、10、11、12が含まれる行データ
のみ残ります。
よろしくお願いします。


●質問者: inosisi
●カテゴリ:コンピュータ インターネット
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● きゃづみぃ
●10ポイント
Public w As Workbook

Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。
p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk As Workbook
Dim gg As Long
Application.DisplayAlerts = False

Dim fdb() As String
 
a = 1
f = Dir(p & "*." & s, vbNormal)
Do While f <> ""
 ReDim Preserve fdb(a)
 fdb(a - 1) = f
 a = a + 1
 f = Dir
Loop


For aaa = 0 To a - 2
 f = fdb(aaa)
 f1 = Left(f, Len(f) - 4)

 csvImp (p & f)
 With w.Sheets(1)
 
 If .Range("F2") = "" Then
 ff = 1
 Else
 ff = .Range("F1").End(xlDown).Row
 End If
 
 For gg = ff To 2 Step -1
 If Not (Int(Trim(.Cells(gg, "F"))) >= 1 And Int(Trim(.Cells(gg, "F"))) <= 12) Then
 .Rows(gg).Delete Shift:=xlUp
 End If
 
 Next gg
 End With
 
 w.Save
 w.Close
 
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvImp(csFName As String)

Const csDelimiter As String = ","

Dim FNo As Integer

Dim wsObj As Worksheet

Dim strGet As String

Dim lRowCnt As Long

Dim i As Long

FNo = FreeFile

If Dir(csFName) <> "" Then

 Open csFName For Input As #FNo
 Set w = Workbooks.Open(Filename:=csFName, UpdateLinks:=False, ReadOnly:=False)
 
 Set wsObj = Workbooks(w.Name).Sheets(1)
 lRowCnt = 1
 
 Do Until EOF(FNo)
 
 Line Input #FNo, strGet
 
 For i = LBound(Split(strGet, csDelimiter)) To UBound(Split(strGet, csDelimiter))
 
 If IsNumeric(Split(strGet, csDelimiter)(i)) = True And Left(Split(strGet, csDelimiter)(i), 1) = "0" Then
 
 wsObj.Cells(lRowCnt, i + 1).NumberFormatLocal = "@"
 
 End If
 
 wsObj.Cells(lRowCnt, i + 1) = Split(strGet, csDelimiter)(i)
 
 Next i
 
 lRowCnt = lRowCnt + 1
 
 Loop
 
 
 Close #FNo

End If

End Sub


Sub WRITE_CSVFile(cnsFILENAME As String)
 Dim GYO As Long  ' 収容するセルの行
 Dim GYOMAX As Long  ' データが収容された最終行
 Dim strREC As String
 Dim FNo As Integer
 
 Dim lRowCnt As Long
 
 FNo = FreeFile

  ' 最終行の取得
 With w.Sheets(1)
 If .Range("F1") = "" Then
 Exit Sub
 End If
 
 If .Range("F2") = "" Then
 ff = 1
 Else
 ff = .Range("F1").End(xlDown).Row
 End If
 
  ' 指定ファイルをOPEN(出力モード)
 Open cnsFILENAME For Output As #FNo
 
  ' 1行目から開始
 GYO = 1
  ' 最終行まで繰り返す
 Do Until GYO > ff
  ' レコードを出力(REC編集処理より受け取る)
 strREC = .Cells(GYO, 1).Value
 For COL = 2 To 19
 strREC = strREC & "," & .Cells(GYO, COL).Value
 Next COL
 
 Print #FNo, strREC
  ' 行を加算
 GYO = GYO + 1
 Loop
 End With
 
 Close #FNo
End Sub


inosisiさんのコメント
ありがとうございます マクロ実行すると コンパイルエラー: subまたはfunctionが定義されていません のメッセージがでてエラーになります よろしくお願いします

きゃづみぃさんのコメント
最初に変数定義があります。 実行は main の関数から お願いいたします。 一応、最初から最後までちゃんと貼りつけてもらえれば エラーが出ないはずですが・・・。

inosisiさんのコメント
すみませんでした貼り付けが悪かったみたいです。 マクロは実行されました マクロ実行の検証結果はまたご報告します

inosisiさんのコメント
どうも何度やってもF列のデータをチェックしに行ってる気配がないのですが F列にあるデータで数字の1、2、3、4、5、6、7、8、9、10、11、12、以外の文字、数字+文字、空白があればその行のデータを削除するマクロをお願いします。 1行目は項目です 結果F列には数字の1、2、3、4、5、6、7、8、9、10、11、12の数字のみが残ります。 よろしくお願いします。

2 ● きゃづみぃ
●90ポイント ベストアンサー
Public w As Workbook
Public 読み込み数 As Long

Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。
p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk As Workbook
Dim gg As Long
Application.DisplayAlerts = False

Dim fdb() As String
 
a = 1
f = Dir(p & "*." & s, vbNormal)
Do While f <> ""
 ReDim Preserve fdb(a)
 fdb(a - 1) = f
 a = a + 1
 f = Dir
Loop


For aaa = 0 To a - 2
 f = fdb(aaa)
 f1 = Left(f, Len(f) - 4)

 csvImp (p & f)
 With w.Sheets(1)
 
 
 For gg = 読み込み数 To 2 Step -1
 d = .Cells(gg, "F")
 d = Val(d)
 If Not (d >= 1 And d <= 12) Then
 .Rows(gg).Delete Shift:=xlUp
 End If
 
 Next gg
 End With
 
 w.Save
 w.Close
 
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvImp(csFName As String)

Const csDelimiter As String = ","

Dim FNo As Integer

Dim wsObj As Worksheet

Dim strGet As String

Dim lRowCnt As Long

Dim i As Long

FNo = FreeFile

If Dir(csFName) <> "" Then

 Open csFName For Input As #FNo
 Set w = Workbooks.Open(Filename:=csFName, UpdateLinks:=False, ReadOnly:=False)
 
 Set wsObj = Workbooks(w.Name).Sheets(1)
 lRowCnt = 1
 
 Do Until EOF(FNo)
 
 Line Input #FNo, strGet
 
 For i = LBound(Split(strGet, csDelimiter)) To UBound(Split(strGet, csDelimiter))
 
 If IsNumeric(Split(strGet, csDelimiter)(i)) = True And Left(Split(strGet, csDelimiter)(i), 1) = "0" Then
 
 wsObj.Cells(lRowCnt, i + 1).NumberFormatLocal = "@"
 
 End If
 
 wsObj.Cells(lRowCnt, i + 1) = Split(strGet, csDelimiter)(i)
 
 Next i
 
 lRowCnt = lRowCnt + 1
 
 Loop
 
 
 Close #FNo
読み込み数 = lRowCnt
End If

End Sub

これで大丈夫かな?


inosisiさんのコメント
ありがとうございました。 今度は大丈夫でした。これでOKです。 また何かありましたら質問上げます。

inosisiさんのコメント
修正できますか F列のデータに12aaaaみたいに数字が頭に付いている場合は削除されないのですが削除できる方法はありますか

きゃづみぃさんのコメント
12aaaaは 削除とすると 12----は 削除? 123456は 削除? 12.+++は 削除? というように 細かい条件を 決めてもらえれば、 それに従った 対処を 考えます。

きゃづみぃさんのコメント
d = .Cells(gg, "F") という行を d = left(.Cells(gg, "F"),2) として できるかな? セルの内容が 数値の場合、文字列として取得できるのかが やってみないとわからないところですが・・・。

inosisiさんのコメント
結果は修正しても頭に数字がつく文字は削除されませんでした 数字の後はいろいろパターンがあって一定していないみたいですので 今後でてきたら集計してみます。

inosisiさんのコメント
返事が遅くなってすみませんでした

inosisiさんのコメント
F列に11aaaみたいに数字が頭にくるデータも混じっていてそのデータが削除されず残ってしまいます。 方法としてsheet2へその削除できないデータのみA列1行目から発生した分のデータを追加しながらおいてそれと該当するデータを削除するようにできれば確率がだいぶ減少するのではないでしょうか。 そのようなマクロができるのであれば再度質問をします。 よろしくおねがいします

きゃづみぃさんのコメント
sheet2へとなると エクセルファイルでの出力となりますね。 CSVなどのテキストファイルは シートは ひとつだけです。

inosisiさんのコメント
遅くなりました マクロ実行用のファイルを使いますxlsmの拡張子です

きゃづみぃさんのコメント
それは オフィス2007以降ですね。

inosisiさんのコメント
はいエクセル2010です

inosisiさんのコメント
本当はF列が数字の1、2、3、4、5、6、7、8、9、10、11、12だけが残るようにするのが一番良いのですが無理でしょうか

きゃづみぃさんのコメント
エクセル2003までしか使用していないので ダメですね。 >1、2、3、4、5、6、7、8、9、10、11、12だけが残るようにするのが 数値の後ろに 何かついてたりするのは 不要ということですか?

inosisiさんのコメント
マクロの中に追加記述する方法でもかまいません たとえば数字の1だけの行と1aaaの行があれば1aaaの行は不要という意味です 1aaaのaaaを取って1だけ残す意味ではありません マクロで削除できない文字だけを直接マクロに記述して削除できればこちらで追加していきます

inosisiさんのコメント
F列 1 4 11 1aaa 答え F列 1 4 11
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ