Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1969 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【70727】該当の文字列から○○をコピーして貼り付け 栗きんとん 11/12/20(火) 14:08 質問[未読]
【70728】Re:該当の文字列から○○をコピーして貼り... つん 11/12/20(火) 14:23 回答[未読]
【70729】Re:該当の文字列から○○をコピーして貼り... 栗きんとん 11/12/20(火) 16:23 質問[未読]
【70730】Re:該当の文字列から○○をコピーして貼り... つん 11/12/20(火) 16:34 回答[未読]
【70734】Re:該当の文字列から○○をコピーして貼り... kanabun 11/12/20(火) 20:54 発言[未読]
【70741】Re:該当の文字列から○○をコピーして貼り... 栗きんとん 11/12/22(木) 17:41 質問[未読]
【70742】Re:該当の文字列から○○をコピーして貼り... kanabun 11/12/22(木) 18:10 発言[未読]
【70752】Re:該当の文字列から○○をコピーして貼り... 栗きんとん 11/12/23(金) 19:34 お礼[未読]
【70727】該当の文字列から○○をコピーして貼り付...
質問  栗きんとん  - 11/12/20(火) 14:08 -
引用なし
パスワード
   マクロ初心者です。
お手数ですが、アドバイスをお願いします。
長文になってしまいますが、よろしくです。

txtから読み込んで、○○シートのA列にInput。＊この部分はOKです

先頭文字がJan　〜　Decから始まるものA列を検索。
一致した行をコピーして××シートのA列へ貼り付け繰り返す。

関数はFindを使うと思うのですが、
上手くいきません。


Sub メッセージ加工()

Dim File種類, Prompt, Item As String
Dim FileNamePath As Variant
Dim B As String, N As Long


File種類 = "txtファイル　(*.txt),*.　txt"
Pronpt = "保存したTFLメールを選択して"
FileNamePath = SelectFileNamePath(File種類, Pronpt)

If FileNamePath = False Then
　　MsgBox "キャンセルしました"
　　End

End If

Open FileNamePath For Input As #1
　　Do Until EOF(1)
　　　　Line Input #1, B
　　　　N = N + 1
　　　　Worksheets("○○").Cells(N, 1) = B
　　　　
　　Loop


Str = ""←検索する文字　Jan〜Decを指定したい＞＜

　　Do
　　　　Set Cell = Columns("A").Find(Str, , xlValues, xlWhole)
　　　　If Cell Is Nothing Then Exit Do
　
　　Loop
【70728】Re:該当の文字列から○○をコピーして貼...
回答  つん  - 11/12/20(火) 14:23 -
引用なし
パスワード
   栗きんとん さん：

こんにちは＾＾

こういう場合は、Like演算子を使われたらいいのではないかなあ？
と思います。
【70729】Re:該当の文字列から○○をコピーして貼...
質問  栗きんとん  - 11/12/20(火) 16:23 -
引用なし
パスワード
   ▼つん さん：
>栗きんとん さん：
>
>こんにちは＾＾
>
>こういう場合は、Like演算子を使われたらいいのではないかなあ？
>と思います。

返信ありがとうございます。

Sub test()
Dim msg As Object
　
　　For Each msg In Worksheets(1).Range("a1:a30")

　　　　If msg.Value Like "Jan" Then
　　　　　 msg.Copy Worksheets(2).Range("A1")
　　　　　
　　　　　 ElseIf msg.Value Like "Feb" Then
　　　　　 msg.Copy Worksheets(2).Range("A2")

　　　　End If
　　Next msg
End Sub

途中ですが、こんな感じでしょうか？
実際に試してみたのですが、問題が・・・

文字列が「Jan 1 2222 1111 Jan 2222 4444]

Janを指定しているので引っかからないようです。
Janから後文字を問わないようにするにはどうすれば・・・
またmsg.Copy Worksheets(2).Range("A1")この部分ですが、
セルAに貼り付けるようにしていますが、
複数検索に一致した場合の対処としてどのようにすればよいですかね？
【70730】Re:該当の文字列から○○をコピーして貼...
回答  つん  - 11/12/20(火) 16:34 -
引用なし
パスワード
   栗きんとん さん

どもども

>　　　　If msg.Value Like "Jan" Then
>　　　　　 msg.Copy Worksheets(2).Range("A1")
>　　　　　
>　　　　　 ElseIf msg.Value Like "Feb" Then
>　　　　　 msg.Copy Worksheets(2).Range("A2")

ちょっと、なさりたいことが、よくわからないんですが。。。

Like "Jan" だと、Janだけのセルしかひっかからないと思います。
「Jan〜〜Dec」を探すんですよね？

だったら
「Cells(i, 1).Value Like "Jan*Dec"」
のように、ワイルドカードを使わないと・・・

Like演算子のヘルプを見ると、いろいろわかると思います。
【70734】Re:該当の文字列から○○をコピーして貼...
発言  kanabun  - 11/12/20(火) 20:54 -
引用なし
パスワード
   ▼栗きんとん さん：
こんにちは〜

>先頭文字がJan　〜　Decから始まるものA列を検索。
ということは、セルの値が
Jan*
Feb*
Mar*
Apr*
May*
Jun*
Jul*
Aug*
Sep*
Oct*
Nov*
Dec*
で始まっているセルだけをCopyしたいってことですよね？

>一致した行をコピーして××シートのA列へ貼り付け繰り返す。
フィルタオプションの設定（Excel2007以降ではフィルタ -「詳細設定」のことです）を
つかわれたらどうでしょう。これなら、Loopする必要ないですし、Jan*〜 Dec* まで
一括抽出できますよ

Sub Try1()
　Dim WS1 As Worksheet
　Dim WS2 As Worksheet
　Dim r As Range
　Dim c As Range
　
　Set WS1 = Worksheets(1)　 'コピー元シート
　Set WS2 = Worksheets(2)　 'コピー先シート
　With WS2
　　　'[AA列]に抽出条件記入　列は空いている列ならどこでもよい
　　　Set c = .Range("AA1").Resize(13)　
　　　c.Value = [{"wkHeader";"Jan*";"Feb*";"Mar*";"Apr*";"May*";"Jun*";"Jul*";"Aug*";"Sep*";"Oct*";"Nov*";"Dec*"}]
　End With
　Application.CutCopyMode = True
　With WS1
　　　.Rows(1).Insert　　　　　　　　　　　　　　　　　'１行挿入
　　　.Range("A1").Value = "wkHeader"　　'作業用に列見出しを書き込む
　　　Set r = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
　　　r.AdvancedFilter xlFilterInPlace, c　　　　　　　　’フィルタオプション実行
　　　If r.SpecialCells(xlVisible).Count > 1 Then　 '１行以上抽出行があったとき
　　　　　Intersect(r, r.Offset(1)).Copy WS2.[A1]　　　'所定シートへコピー
　　　End If
　　　.ShowAllData
　　　.Rows(1).Delete
　End With
End Sub
【70741】Re:該当の文字列から○○をコピーして貼...
質問  栗きんとん  - 11/12/22(木) 17:41 -
引用なし
パスワード
   ▼kanabun さん：
>▼栗きんとん さん：
>こんにちは〜
>
>>先頭文字がJan　〜　Decから始まるものA列を検索。
>ということは、セルの値が
>Jan*
>Feb*
>Mar*
>Apr*
>May*
>Jun*
>Jul*
>Aug*
>Sep*
>Oct*
>Nov*
>Dec*
>で始まっているセルだけをCopyしたいってことですよね？
>
>>一致した行をコピーして××シートのA列へ貼り付け繰り返す。
>フィルタオプションの設定（Excel2007以降ではフィルタ -「詳細設定」のことです）を
>つかわれたらどうでしょう。これなら、Loopする必要ないですし、Jan*〜 Dec* まで
>一括抽出できますよ
>
>Sub Try1()
>　Dim WS1 As Worksheet
>　Dim WS2 As Worksheet
>　Dim r As Range
>　Dim c As Range
>　
>　Set WS1 = Worksheets(1)　 'コピー元シート
>　Set WS2 = Worksheets(2)　 'コピー先シート
>　With WS2
>　　　'[AA列]に抽出条件記入　列は空いている列ならどこでもよい
>　　　Set c = .Range("AA1").Resize(13)　
>　　　c.Value = [{"wkHeader";"Jan*";"Feb*";"Mar*";"Apr*";"May*";"Jun*";"Jul*";"Aug*";"Sep*";"Oct*";"Nov*";"Dec*"}]
>　End With
>　Application.CutCopyMode = True
>　With WS1
>　　　.Rows(1).Insert　　　　　　　　　　　　　　　　　'１行挿入
>　　　.Range("A1").Value = "wkHeader"　　'作業用に列見出しを書き込む
>　　　Set r = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
>　　　r.AdvancedFilter xlFilterInPlace, c　　　　　　　　’フィルタオプション実行
>　　　If r.SpecialCells(xlVisible).Count > 1 Then　 '１行以上抽出行があったとき
>　　　　　Intersect(r, r.Offset(1)).Copy WS2.[A1]　　　'所定シートへコピー
>　　　End If
>　　　.ShowAllData
>　　　.Rows(1).Delete
>　End With
>End Sub

つん氏、kanabun氏
返信ありがとうございます。
記載が遅くなり申し訳ありません。

すいません、誤解をさせてしまったようです。
先頭文字列をJan　〜　Decから始まるA列を検索し
行をすべてコピーしたいのです。

※検索する文は以下のようにセルA1からインプットされます。
（区切りはされずセルAすべて記載されます）
　　　Ａ　　　
１　　Jan 20111221 aaa
２　　Feb 20111221 AAA
３　　Mar 20111222 bbb
４　　Apr 20111222 BBB
５　　May 20111223 ccc
６　　Jun 20111223 CCC
７　　Jul 20111224 ddd
８　　Aug 20111224 DDD
９　　Sep 20111225 eee
１０　Oct 20111225 EEE
１１　Nov 20111226 fff
１２　Dec 20111226 FFF
１３　日時: 2011年8月17日 12:39　
１４　差出人: ＫＫＫＡＡＡＢＢＢ

１３、１４のように不要な文章が多くインプットされてしまうので、
１３、１４を除くものをJan　〜　Decから始める行をコピーしたいのです。

何が一番いいのかさっぱりです。
FunctionプロシージャでJan〜Decをkeyとして一致したら
その行を出力するのが一番なんでしょうか・・・
【70742】Re:該当の文字列から○○をコピーして貼...
発言  kanabun  - 11/12/22(木) 18:10 -
引用なし
パスワード
   ▼栗きんとん さん：

>すいません、誤解をさせてしまったようです。
>先頭文字列をJan　〜　Decから始まるA列を検索し
>行をすべてコピーしたいのです。
>
>※検索する文は以下のようにセルA1からインプットされます。
>（区切りはされずセルAすべて記載されます）
>　　　Ａ　　　
>１　　Jan 20111221 aaa
>２　　Feb 20111221 AAA
>３　　Mar 20111222 bbb
>４　　Apr 20111222 BBB
>５　　May 20111223 ccc
>６　　Jun 20111223 CCC
>７　　Jul 20111224 ddd
>８　　Aug 20111224 DDD
>９　　Sep 20111225 eee
>１０　Oct 20111225 EEE
>１１　Nov 20111226 fff
>１２　Dec 20111226 FFF
>１３　日時: 2011年8月17日 12:39　
>１４　差出人: ＫＫＫＡＡＡＢＢＢ
>
>１３、１４のように不要な文章が多くインプットされてしまうので、
>１３、１４を除くものをJan　〜　Decから始める行をコピーしたいのです。

ええ、そのような問題と理解してますけど？
【70752】Re:該当の文字列から○○をコピーして貼...
お礼  栗きんとん  - 11/12/23(金) 19:34 -
引用なし
パスワード
   ▼kanabun さん：
>▼栗きんとん さん：
>
>>すいません、誤解をさせてしまったようです。
>>先頭文字列をJan　〜　Decから始まるA列を検索し
>>行をすべてコピーしたいのです。
>>
>>※検索する文は以下のようにセルA1からインプットされます。
>>（区切りはされずセルAすべて記載されます）
>>　　　Ａ　　　
>>１　　Jan 20111221 aaa
>>２　　Feb 20111221 AAA
>>３　　Mar 20111222 bbb
>>４　　Apr 20111222 BBB
>>５　　May 20111223 ccc
>>６　　Jun 20111223 CCC
>>７　　Jul 20111224 ddd
>>８　　Aug 20111224 DDD
>>９　　Sep 20111225 eee
>>１０　Oct 20111225 EEE
>>１１　Nov 20111226 fff
>>１２　Dec 20111226 FFF
>>１３　日時: 2011年8月17日 12:39　
>>１４　差出人: ＫＫＫＡＡＡＢＢＢ
>>
>>１３、１４のように不要な文章が多くインプットされてしまうので、
>>１３、１４を除くものをJan　〜　Decから始める行をコピーしたいのです。
>
>ええ、そのような問題と理解してますけど？

すいません、実際に動作確認して、問題ありませんでした。
親切にコードまで記載して頂いたのに、
失礼な記載をして申し訳ありません。
ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1969 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free