[[20190328103440]] 『特定の文字を含む列以外を削除する方法』(ももんが) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定の文字を含む列以外を削除する方法』(ももんが)

お世話になっております。
1行目をタイトル行にしており、特定の文字が含まれている列以外を削除したいと思っております。
ネットで見つけた下記のコードを利用しようとしているのですが、
特定の文字が複数ある場合、「keyWord = "氏名"」の部分をどのようにしたらよいでしょうか。

Sub 特定の文字列を含む列以外を削除()

   With ActiveWorkbook.ActiveSheet

       Const startcol As String = "1"  '開始列(残したい列,2=B列→A列は消えない)
       Const row As String = "1"  '文字列が入力されている行
       Dim idx As Long
       Dim keyWord

       keyWord = "氏名"

       If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then
           For idx = .Cells(row, 16384).End(xlToLeft).Column To startcol Step -1
               If InStr(.Cells(row, idx).Value, keyWord) = 0 Then
                   Columns(idx).Delete
               End If
           Next idx
       End If
   End With
End Sub

< 使用 Excel:Excel2013、使用 OS:Windows8 >


 keyWordの何れかを含む列のみを残す。

 Sub test()
     Dim ii As Long, keyWord
     Const StartCol As Long = 1, myRow As Long = 1
     keyWord = Array("氏名", "住所", "電話")
     If IsArray(keyWord) Then keyWord = Join(keyWord, "|")
     With CreateObject("VBScript.RegExp")
         .Pattern = keyWord
         For ii = Cells(myRow, Columns.Count).End(xlToLeft).Column To StartCol + 1 Step -1
             If Not .test(Cells(myRow, ii).Value) Then Columns(ii).Delete
         Next
     End With
 End Sub
(seiya) 2019/03/28(木) 12:09

seiya様

ありがとうございました。
大変助かりました。
(ももんが) 2019/03/28(木) 13:17


seiya様

先程はありがとうございました。
私が勘違いしていた部分があり、追加で教えて頂ければと思っております。

1.特定の文字が含まれる列ではなく特定の文字の列にするにはどうしたらよいでしょうか。

2.教えていただいたコードはA列が消えませんが、A列も含めて削除対象にするにはどうしたらよいでしょうか。

お手間をとらせてしまい大変申し訳ありませんが、教えて頂ければと思っております。
よろしくお願い致します。
(ももんが) 2019/03/28(木) 13:58


 >Const startcol As String = "1"  '開始列(残したい列,2=B列→A列は消えない)
 もともとのコードは1を指定した場合A列も対象にしていましたからね...

 このように変更してください。 

 Sub test()
     Dim ii As Long, keyWord
     Const myRow As Long = 1
     keyWord = Array("氏名", "住所", "電話")
     If IsArray(keyWord) Then keyWord = Join(keyWord, "|")
     With CreateObject("VBScript.RegExp")
         .Pattern = "^(" & keyWord & ")$"
         For ii = Cells(myRow, Columns.Count).End(xlToLeft).Column To 1 Step -1
             If Not .test(Cells(myRow, ii).Value) Then Columns(ii).Delete
         Next
     End With
 End Sub
(seiya) 2019/03/28(木) 14:09

seiya様

ありがとうございました。
お手数をおかけいたしました。
大変助かりました。
(ももんが) 2019/03/28(木) 16:39


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.