| |
▼UO3 さん：
ご連絡ありがとうございます。
ご連絡ありがとうございます。
殆どコピーして引用致します。
ただ、個人的な事で申し訳ありませんが、名前（オブジェクト？名）については、
一部、代替させて頂きました事をご理解頂ければ幸いです。
***************************************************************
Private Sub 反映転記_Click()
Dim myrow As Long
With Sheets("List")
If WorksheetFunction.CountA(Rows(2)) = 0 Then
myrow = 2
Else
myrow = .UsedRange.Cells(.UsedRange.Cells.Count).Row + 1
End If
'----------------------------------------
.Cells(myrow, 1).Value = 番号.Value
.Cells(myrow, 2).Value = 氏名.Value
.Cells(myrow, 3).Value = 氏名_カナ.Value
.Cells(myrow, 4).Value = 組合.Value
.Cells(myrow, 5).Value = 代表.Value
.Cells(myrow, 6).Value = 郵便番号.Value
.Cells(myrow, 7).Value = 住所1.Value
.Cells(myrow, 8).Value = 住所2.Value
.Cells(myrow, 9).Value = 電話番号.Value
.Cells(myrow, 10).Value = ファックス番号.Value
.Cells(myrow, 11).Value = メールアドレス.Value
.Cells(myrow, 12).Value = 内線番号1.Value
.Cells(myrow, 13).Value = 内線番号12.Value
If 平日.Value Then .Cells(myrow, 14).Value = 平日.Caption
If 土日祝日.Value Then .Cells(myrow, 15).Value = 土日祝日.Caption
If 不明.Value Then .Cells(myrow, 16).Value = 不明.Caption
.Cells(myrow, 17).Value = 曜日メモ.Value
If 電話連絡.Value Then .Cells(myrow, 18).Value = 電話連絡.Caption
If ファックス.Value Then .Cells(myrow, 19).Value = ファックス.Caption
If メール.Value Then .Cells(myrow, 20).Value = メール.Caption
If アカ.Value Then .Cells(myrow, 21).Value = アカ.Caption
If ミドリ.Value Then .Cells(myrow, 22).Value = ミドリ.Caption
If シロ.Value Then .Cells(myrow, 23).Value = シロ.Caption
If キイロ.Value Then .Cells(myrow, 24).Value = キイロ.Caption
If 黒.Value Then .Cells(myrow, 25).Value = 黒.Caption
.Cells(myrow, 25).Value = その他_備考.Value
End With
End Sub
***************************************************************
また、今回手持ちの書籍を確認しておりましたが、「全角カタカナ」を
「半角カタカナ」に変換するスクリプトを見つけました。
myStr = "アイウ"
Range("A5").Value = myStr & "→半角に変換"
Range("B5").Value = StrConv(myStr, vbNarrow)
これを例えば
If アカ.Value Then .Cells(myrow, 21).Value = アカ.Caption
の部分に利用したいなどの場合はいかがなものなのでしょうか。
度々恐縮ですが、ご連絡お待ちしております。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
