[[20120911194731]]　『エクセルVBAの特定文字を含むセルの選択について』（naru）　ページの最後に飛ぶ

『エクセルVBAの特定文字を含むセルの選択について』（naru）excel2000

 A 　　　　　B　　　　　 C
 りんご　　山本商店　　B1-367098
 みかん　　　　　　　　B1-367099
　　　　　　　　　　　 B1-367100
                       B1-367101
                       B1-367098 
                       B1-367098
                       AH-367111
                       AH-367367
                       AH-374311
                       AH-374312
　　　　　　　　　　　　　・　　
　　　　　　　　　　　　　・
 上記のような表があり、C列のセルの頭二文字(B1とかAH)でならんでいます。
 この頭二文字で並んでるセル範囲を取得して（B1ならA1：C6まで)
 頭二文字の名前がついている別シートへコピペしたいのですが
 Ｃ列頭二文字の種類は全部で五種類ほどあります）
 ・c列　leftで頭二文字　取り出す
 ・c列上からと下からで位置を取得してからresizeする
 でいいのでしょうか？
 vba初心者でなかなか頭でまとまりません。御指導下さい。

 >B1ならA1：C6まで

 AH なら？　A7～C10 ?
 もしそうなら、本当は、１行目をタイトル行にしてオートフィルタを使うのがてっとりばやいよ。
 (マクロがよければ、マクロで）

 ところで、絞り込みの２文字の指定方法はどう考えている？

 (ぶらっと)

 現在のレイアウトだとして別案。（とりあえず抽出文字列は固定で与えている）

 Sub Test()
    Dim s As String
    Dim f As Range
    Dim t As Range

    s = "B1*"       '抽出すべき頭文字

    With Sheets("Sheet1")       '元シート
        Set f = .Columns("C").Find(What:=s, After:=.Range("C" & Rows.Count), LookAt:=xlWhole)
        If f Is Nothing Then
            MsgBox "データが見つかりません"
        Else
            Set t = .Columns("C").Find(What:=s, After:=.Range("C1"), SearchDirection:=xlPrevious, LookAt:=xlWhole)
            With Sheets("Sheet2")           '転記シート
                .UsedRange.ClearContents
                Range(f, t).Offset(, -2).Resize(, 3).Copy .Range("A1")
                .Select
            End With
            MsgBox "抽出コピー完了"
        End If
    End With

 End Sub

 追記）

 Range(f, t).Offset(, -2).Resize(, 3).Copy .Range("A1")

 これは

 Range(f.Offset(, -2), t).Copy .Range("A1")

 こう記述したほうがわかりやすいかも。

 (ぶらっと)

 レイアウトが今のまま（タイトル行無し）だとして最初に言った、オートフィルター案
 このコードは、ほとんどマクロ記録したものをつなぎ合わせて、すこしお化粧直しすればできあがる。
 抽出文字列は上記同様、固定で与えている。

 Sub Test2()
    Dim s As String
    Dim f As Range
    Dim t As Range
    Dim r As Range
    Dim shTo As Worksheet

    Application.ScreenUpdating = False

    s = "B1*"                   '抽出すべき頭文字
    Set shTo = Sheets("Sheet2") '転記シート

    With Sheets("Sheet1")       '元シート
        .AutoFilterMode = False
        .Rows(1).Insert Shift:=xlDown                   'フィルター用タイトル行を挿入
        .Range("A1:C1").Value = Array("A", "B", "C")    'フィルター用タイトル
        .Range("A1").AutoFilter Field:=3, Criteria1:="=" & s
        shTo.UsedRange.ClearContents
        .AutoFilter.Range.Copy shTo.Range("A1")
        If shTo.Range("A1").CurrentRegion.Rows.Count = 1 Then
            MsgBox "データが見つかりません"
        End If
        shTo.Rows(1).Delete
        .AutoFilterMode = False
        .Rows(1).Delete
    End With

    shTo.Select
    Application.ScreenUpdating = True
    MsgBox "抽出コピー完了"

 End Sub

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20120911194731]] 『エクセルVBAの特定文字を含むセルの選択について』（naru） ページの最後に飛ぶ

[[20120911194731]]　『エクセルVBAの特定文字を含むセルの選択について』（naru）　ページの最後に飛ぶ