[[20120517133124]]　『マクロ』（ぴょん）　ページの最後に飛ぶ

『マクロ』（ぴょん）

お世話になります。
下記のマクロにて抽出したデータ（数字）の頭に
「A」という文字を付け、且つデータ（数字）の
下2ケタを削除する方法を探しております。
どなた様かお知恵を貸して下さい。

Sub sample()
Dim n As Integer
Dim LastR1 As Long, LastR2 As Long

    For n = 1 To Worksheets.Count                       'データシートの数だけループ
        LastR1 = Sheets(1).Range("A65536").End(xlUp).Row '貼付先シートの最終行取得
        LastR2 = Sheets(n).Range("A65536").End(xlUp).Row '貼付元シートの最終行取得
        With Sheets(n)                          '貼付元データをコピー(最終行の1行下まで)
            .Range("B125").Copy
             End With
        ActiveSheet.Paste Destination:=Sheets(1).Cells(LastR1 + 1, 1) '貼付(1行下を起点)
    Next
End Sub

 抽出したデータがどれをさしているのか判らなかったのでSheets(1).Cells(LastR1 + 1, 1) の値と解釈しました。
 不細工なコードだと言うことは重々承知なので参考程度に留めておいてください。

 Sub sample()
 Dim n As Integer
 Dim LastR1 As Long, LastR2 As Long
 Dim myStr As String, myStr2 As String
 Dim myAns As Variant

    For n = 1 To Worksheets.Count                       'データシートの数だけループ
        LastR1 = Sheets(1).Range("A65536").End(xlUp).Row '貼付先シートの最終行取得
        LastR2 = Sheets(n).Range("A65536").End(xlUp).Row '貼付元シートの最終行取得
        With Sheets(n)                          '貼付元データをコピー(最終行の1行下まで)
            .Range("B125").Copy
        End With
        ActiveSheet.Paste Destination:=Sheets(1).Cells(LastR1 + 1, 1) '貼付(1行下を起点)

        With ActiveSheet'=====ここらへんから追加
            myStr = .Cells(LastR1 + 1, 1).Value '=====貼りつけた値をmyStrと言う変数にする。
            myStr2 = Right(myStr, 2) '=====myStrの下2桁の文字
            myAns = Application.WorksheetFunction.Substitute(myStr, myStr2, "") '=====myStrから下2桁を削除した値
            MsgBox "A" & myAns '=====頭にAを付ける
        End With
    Next
 End Sub

 (毛虫通過中@場繋ぎ)

 衝突しましたがそのまんま・・・
 > With Sheets(n)                          '貼付元データをコピー(最終行の1行下まで)
 >      .Range("B125").Copy
 > End With
 > ActiveSheet.Paste Destination:=Sheets(1).Cells(LastR1 + 1, 1) '貼付(1行下を起点)

 この部分を 
 With Sheets(n).Range("B125")
    Sheets(1).Cells(LastR1 + 1, 1).Value = "A" & Left(.Value, IIf(Len(.Value) > 2, Len(.Value) - 2, Len(.Value)))
 End With
 にしてみるとか。

 蛇足ですが
 >LastR1 = Sheets(1).Range("A65536").End(xlUp).Row '貼付先シートの最終行取得
 これはループする度に一々同じ事を実行していますので非効率的ですね。
 FOR～NEXTループに入る前に代入した方が良いと思います。
 あと、LastR2の方は代入だけしたものの実際一度も使っていませんので削除して良さそうですね。

 (Jera)

 あ、ごめんなさい。シート1の下に各シートの値を次々追加していくコードだったんですね。
 ならLastR1はループ内に入れないと動きませんね。失礼しました。
 (Jera)

お二方共ありがとうございました。

当方の説明が不足しておりました。
シートの構成は「有効1」「無効1」「有効2」「無効2」～と交互に並んでおり、
「有効」のB125を抽出しています。

Jera様のマクロを実行しますと

A123456
A
A234564
A
A345678

と「A」のみのセルが出てきてしまうのですが?
これを出なくなる方法はござますか?
重ね重ね申し訳ございません。

（ぴょん）

 必ず交互に並んでいるなら
 For n = 1 To Worksheets.Count
 を
 For n = 1 To Worksheets.Count step 2
 にするか、シート名で判定するかですね。
 If Sheets(n).Name Like "*有効*" Then とかでできると思います。
 (Jera)

Jera様

有難うございました。
無事解決致しました。
（ぴょん）

コメント返信：

[ 一覧(最新更新順) ]

[[20120517133124]] 『マクロ』（ぴょん） ページの最後に飛ぶ

[[20120517133124]]　『マクロ』（ぴょん）　ページの最後に飛ぶ