一つのセルの文字列を分解して別のシートへ

いつもお世話になっております。
一つのセルの文字列を分解して別のシートの指定したセルに一文字ずつ入力したいと考えています。
（例）
　 A　B C 　D E 　　　　　　F ・・・・・・・・・・・　　　　ＡＤ
1 2014/5/1 ・・・・ 　　2014/5/6・・・・・・・・・・・2014/5/31
2
3　　　　　　　　　　　　　　　こ
4
5　　　　　　　　　　　　　　　ど
6
7　　　　　　　　　　　　　　　も
8　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
9　　　　　　　　　　　　　　　の

別シートには、祝日の一覧が作成してあり、一つのセル"こどもの日"のように入力してあります。
F1のセルが2014/5/6なので、別シートの祝日データからデータをとばして、Ｆ3のセルに"こ"、一つ飛ばしてF5のセルに"ど"、F6のセルに"も"のように自動で入力したいのですが（他の祝日も同じく）、そういったことはマクロで可能でしょうか？
よろしくお願いいたします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2014/04/19 22:07

こんばんは！

＞F1のセルが2014/5/6なので・・・
「こどもの日」は5月5日でお示しの配列だとE列になり、F列は振替休日だと思います。

それはさておいて、↓の画像のようなデータをSheet2に作成しておくとします。
Sheet1の1行目にシリアル値が入っているとしてのコードです。
標準モジュールです。

Sub Sample1()
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
Dim str As String, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
lastRow = .UsedRange.Rows.Count
lastCol = .UsedRange.Columns.Count
If lastRow > 1 Then
Range(.Cells(2, 1), .Cells(lastRow, lastCol)).ClearContents
End If
For j = 1 To lastCol
Set c = wS.Cells.Find(what:=.Cells(1, j), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
str = wS.Cells(c.Row, "A")
For i = 1 To Len(str)
With .Cells(2 * i + 1, j)
.Value = Mid(str, i, 1)
.HorizontalAlignment = xlCenter
End With
Next i
End If
Next j
End With
End Sub

※　関数でないのでSheet1のデータ変更があるたびにマクロを実行する必要があります。m(_ _)m

この回答へのお礼

ご回答ありがとうございました。
無事に解決することができました！

お礼日時：2014/04/27 23:27