Excel VBA質問箱 IV

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

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


9022 / 13644 ツリー ←次へ | 前へ→

【29768】金額を1桁ずつ分けて表示させたい ハル 05/10/13(木) 11:57 質問[未読]
【29769】Re:金額を1桁ずつ分けて表示させたい seiya 05/10/13(木) 12:25 回答[未読]
【29770】Re:金額を1桁ずつ分けて表示させたい ハル 05/10/13(木) 12:53 発言[未読]
【29772】Re:金額を1桁ずつ分けて表示させたい ハル 05/10/13(木) 13:48 質問[未読]
【29773】Re:金額を1桁ずつ分けて表示させたい seiya 05/10/13(木) 14:16 回答[未読]
【29775】Re:金額を1桁ずつ分けて表示させたい ハル 05/10/13(木) 15:27 お礼[未読]
【29774】Re:金額を1桁ずつ分けて表示させたい seiya 05/10/13(木) 14:29 回答[未読]

【29768】金額を1桁ずつ分けて表示させたい
質問  ハル  - 05/10/13(木) 11:57 -

引用なし
パスワード
   こんにちは、いつも参考にさせていただいています。

早速ですがあるシートに表示されている金額を
別シート(印刷用フォーマット)に表示させたいのですが、
書式の形式上、ひとつのセルに1桁ずつ表示させることはできますか?

以前別の掲示板で見つけた関数で、数字を1桁ずつ分ける式は
あったのですが、数字以外にも △(マイナス)や、¥マークなども
表示できるようにしたいのです。

どなたかわかる方がいらっしゃいましたら、教えてください。


例)
     A
1   2,000,000
2    -425,000  
3  ¥1,575,000

  これを別シートに

   A B C D E F G H I J

1        2  0  0  0  0  0  0
2        △  4  2  5  0  0  0
3      ¥ 1  5  7  5  0  0  0

   このように表示させたい。

金額は、その時によってまちまちで桁数もバラバラです。
¥マークは必ず一番大きい桁の一つ隣に表示させるようにしたいです。

よろしくお願いします

【29769】Re:金額を1桁ずつ分けて表示させたい
回答  seiya  - 05/10/13(木) 12:25 -

引用なし
パスワード
   ▼ハル さん:

>以前別の掲示板で見つけた関数で、数字を1桁ずつ分ける式は
>あったのですが、数字以外にも △(マイナス)や、¥マークなども
>表示できるようにしたいのです。

関数での解決方法は私には無理ですが、vbaならこういう感じですか

Sub test()
Dim rng As Range, r As Range, n As Integer
With Sheets("sheet1")
  Set rng = .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
End With
  For Each r In rng
    If IsNumeric(r) Then
      txt = Replace(r.Text, "-", "△")
      txt = Replace(txt, ",", "") '<-- カンマも必要なら削除
      x = Len(txt)
      With Sheets("sheet2")
        With .Cells(.Rows.Count, "j").End(xlUp).Offset(1)
         For i = 1 To x
          .Offset(, -(x - i)) = Mid(txt, i, 1)
        Next
        End With
      End With
    End If
  Next
End Sub

【29770】Re:金額を1桁ずつ分けて表示させたい
発言  ハル  - 05/10/13(木) 12:53 -

引用なし
パスワード
   ▼seiya さん:
>
>関数での解決方法は私には無理ですが、vbaならこういう感じですか

ご回答ありがとうございます。

早速試してみます。
また報告させていただきます。
 

【29772】Re:金額を1桁ずつ分けて表示させたい
質問  ハル  - 05/10/13(木) 13:48 -

引用なし
パスワード
   ▼seiya さん:

早速試してみたのですが、途中でエラーが出てしまいます。 

> .Offset(, -(x - i)) = Mid(txt, i, 1)
 
ここの記述部分で

実行時エラー'1004'
アプリケーション定義またはオブジェクト定義のエラーです。

とでてきます。

せっかく教えていただいたのに申し訳ありませんが、どうしてだか
わかりますか?

あと、先ほどの例とは違って一度に複数の金額を反映させることは
可能でしょうか?

例2)
《sheet1》
    A    B    C    D    E    F
1   名前   金額   繰越   消費税  合計 
2   はなこ  50,000       2,500  \52,500
3   たろう  45,000  -5,000  2,000  \42,000
4   あきこ  150,000  50,000  10,000 \210,000 
 
《sheet2》
フォーマット1ページのサイズ
A1〜Z10
    G    H    I J K L M N O P
6   はなこ            5 0 0 0 0
7
8                    2 5 0 0
9                \ 5 2 5 0 0



16  たろう            4 5 0 0 0
17                 △ 5 0 0 0
18                  2 0 0 0
19               \ 4 2 0 0 0




【29773】Re:金額を1桁ずつ分けて表示させたい
回答  seiya  - 05/10/13(木) 14:16 -

引用なし
パスワード
   だいぶ変わりましたね。

Sub test()
Dim rng As Range, r As Range, c As Range, txt As String
Dim i As Integer, n As Integer, j As Integer, x As Integer
With Sheets("sheet1")
  Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 5)
End With
  For Each r In rng
    If r.Column = 1 Then
      Set c = Sheets("sheet2").Range("g6").Offset(n)
      c = r
      n = n + 10: j = 0
    ElseIf Not IsEmpty(r) Then
      txt = Replace(r.Text, "-", "△")
      txt = Replace(txt, ",", "") '<-- カンマも必要なら削除
      x = Len(txt)
      With c.Offset(j, 9)
        For i = 1 To x
          .Offset(, -(x - i)) = Mid(txt, i, 1)
        Next
      End With
      j = j + 1
    Else
      j = j + 1
    End If
  Next
End Sub

【29774】Re:金額を1桁ずつ分けて表示させたい
回答  seiya  - 05/10/13(木) 14:29 -

引用なし
パスワード
   ▼ハル さん:
>▼seiya さん:
>
>早速試してみたのですが、途中でエラーが出てしまいます。 
>
>> .Offset(, -(x - i)) = Mid(txt, i, 1)
> 
>ここの記述部分で
>
>実行時エラー'1004'
>アプリケーション定義またはオブジェクト定義のエラーです。
>
>とでてきます。
>
>せっかく教えていただいたのに申し訳ありませんが、どうしてだか
>わかりますか?

おそらく空白セルに反応してしまったんだと思います。
IsNumeric関数は、空白セルもTrueを返しますので。

【29775】Re:金額を1桁ずつ分けて表示させたい
お礼  ハル  - 05/10/13(木) 15:27 -

引用なし
パスワード
   ▼seiya さん:
>だいぶ変わりましたね。

すみません・・・せっかく教えていただいたのに。
2回目に教えてもらったコードの記述でうまくいきました。

本当にありがとうございました。

9022 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free