[[20130517093500]]　『終了の直前に全角→半角』（ひで）　ページの最後に飛ぶ

『終了の直前に全角→半角』（ひで）

ワークシートの終了際にすべてのシートの
C1～G50までの枠内のアルファベット全角を半角に変換し，

上書き保存して終了するようにしたく，Workbook_BeforeCloseで処理したいのですが，
うまくいきません。
マクロの知識もあまり無く，過去検索したものを参考にさせて頂きました。
よろしくご教授ください。
以下のマクロを　This　workbookに保存しました。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

 Dim Sh As Worksheet
 Dim C As Range
 Dim MyStr As String
 MyStr = "c1:g1000"
     For Each Sh In Worksheets
        For Each C In Sh.Range(MyStr)
            C.Value = StrConv(C, vbNarrow)
        Next C
     Next Sh

End Sub

 BeforeCloseコードで全角→半角に変換されますが
 保存せずに閉じたら、次に開いた時に
 最後に保存した状態（全角が混ざった状態）が開きますが
 そういった「うまくいかない」じゃないですか？

 (HANA)

Private Sub Workbook_BeforeClose(Cancel As Boolean)

 Dim Sh As Worksheet
 Dim C As Range
 Dim MyStr As String
 MyStr = "c1:g1000"
     For Each Sh In Worksheets
        For Each C In Sh.Range(MyStr)
            C.Value = StrConv(C, vbNarrow)
        Next C
     Next Sh
Activeworkbook.save
End Sub

としてみましたが，
Next　C　でとまってしまいます。
（ひで）

 ＞Next　C　でとまってしまいます。
 と言うのは、具体的にどういった事でしょう？

 エラーメッセージが出る　とか？
 でしたら、何と出てますか？
 また、その時の C の値は何ですか？

 ちなみに、セルC　に入力されている文字を変換するので
 C.Value = StrConv(C.Value, vbNarrow)
 って書いておくと、何か変わりますか？

 (HANA)

変わりませんでした。

実行すると半角には変換するのですが，そのあとカーソルが点滅して
バグを起こしているようです。
ＥＳＣを押し，コードの中断させると
ＮＥＸＴ　Ｃが黄色く反転している状況です。
よろしくお願いします。（ひで）

 「処理に時間がかかってるだけ」って事は無いですか？
 シートのループをなくし
 セル範囲も10セル程度にして
 確認してみるとどうですか？

 その際、ブレークポイントを設定して
 一行ずつ実行してみるとわかりやすいかもしれません。

 コードが書いてある部分（白い部分）の左側に
 灰色（余白？）部分があると思います。
 ＞C.Value = StrConv(C.Value, vbNarrow)
 と同じ行の灰色の部分をクリックしてもらうと
 茶色い●が　表示されます。

 マクロが実行されると、一旦この部分で止まりますので
 [F8]を押しながら一行ずつ実行して確認してみて下さい。

 (HANA)

HANAさん。
範囲をG50までにしたらできました。ただ，２０－３０秒くらいかかります。もっと瞬時にできるものかと思いました。
もう一つお願いできませんか。

離れた２カ所の範囲を処理させるにはどうしたらよいでしょうか。
シートは全部で３枚で（シート名は国，国２，国３です）

１カ所目C1～G50（全シート）
２カ所目L1～Q50（国２,国３)

です。
教えて頂ければ幸いです。よろしくお願いします。

 ＞もっと瞬時にできるものかと思いました。 
 一つずつセルにアクセスして、一つずつ書き込んでいますので
 範囲が広いと時間もかかると思います。

 今回は、セルの値だけが対象なので
 配列に取り込んで処理をする
 と、早くなるかもしれません。

 他の方法として、
 '------
    Sheets("国").Range("C1:G50").Value = [INDEX(ASC(国!C1:G50),)]
    Sheets("国２").Range("L1:Q50").Value = [INDEX(ASC(国２!L1:Q50),)]
    Sheets("国３").Range("L1:Q50").Value = [INDEX(ASC(国３!L1:Q50),)]
 '------

 こんなのや、ごちゃごちゃしますがもう少し範囲を自動的に

 '------
    Dim C As Range
    Dim ShA As Variant, CA As Variant
    Dim i As Long
ShA = Array("国", "国２", "国３")
CA = Array("C:G", "L:Q", "L:Q")
    For i = 0 To UBound(ShA, 1)
        With Sheets(ShA(i))
            Set C = Application.Intersect(.UsedRange, .Range(CA(i)))
            If Not C Is Nothing Then
                C.Value = Application.Asc(C)
                Set C = Nothing
            End If
        End With
    Next
 '------

 こんなので早くなるかもしれません。

 後者のコードは、変換する列を　各変数：ShA－CA　の対応で指定し
 行範囲は「UsedRange」を自動認識にしてあります。

 (HANA)

ありがとうございました。
理想にかなり近づいています。
何とか頑張ってみます。（ひで）

コメント返信：

[ 一覧(最新更新順) ]

[[20130517093500]] 『終了の直前に全角→半角』（ひで） ページの最後に飛ぶ

[[20130517093500]]　『終了の直前に全角→半角』（ひで）　ページの最後に飛ぶ