Excelノート　15-02　セルのデータ

HOME　　検索　　索引　　もくじ　　関数目次　　前ページへ　　次ページへ

タイトル欄のアドレスは、エクセルファンクラブの該当する頁へのリンク先です。
詳しい事は、こちらのお願いをご覧になってください。

21 　指定のセル範囲に、もし１が入力されたら"国"に変換、 もし２が入力されたら"算"に変換するには
22　 ちょっと便利な時間割入力
23　 選択数式はそのままで値のみをクリアしたい
24 　複数のセルに分かれた値を、文字列で１つのセルに連結させるには
25　 半角数字を全角にするには、全角数字を半角にするには
26　 クリックでセルのデータを入れ替えるには
27　 （C)が©になってしまう
28　 ひとつのセルのデータを複数のセルに分割するには
29　 郵便番号を入力し、郵便番号、住所を表示するには
30　 文字列の形式を置き換えます
31 　ひらがなをカタカナ（半角・全角）に、カタカナ（半角・全角）をひらがなにするには
32　 文字数が15文字を越えたら隣のセルに入力するには？
33　文字列から数値だけを抽出するには？
34　全角英数カナを半角英数カタカナに一括変換するには
35　Ａ列の漢字のふりがなを、Ｂ列に表示するには？
36　任意の列が変更･削除されたとき、メッセージを出して変更付加にするには
37　ダブルクリックで今日の日付を入れたり消したりするには？
38　数式や関数で参照した場合に、ふりがな情報も参照するには？
39　結合したセルを含む列に、連番を振るには？
40　ほかからコピーした漢字のフリガナを表示するには？

21 指定のセル範囲に、もし１が入力されたら"国"に変換、
もし２が入力されたら"算"に変換するには
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200101/01010021.txt
　　「ユーザー設定のツールバーに、任意の文字列でボタンを登録できますか」　
　　　　　【編集ラウンジ】
マクロ以外の方法
　※　入力規則を使う
　※　使わないキー等を、オートコレクトに登録する。
　※　表示形式／"国";"算";"理";"社"として、それぞれ"1,-1,0,a"のように入力する
　※　簡単な入力のあと、置換を利用する。
　※　その他、単純にIMEに登録したり、vlookup 他の関数を使う。
このコードは、Excel5.0、95でも使えます。
Sub Auto_Open()
　Worksheets(1).OnEntry = "Test変換"
End Sub
Sub Test変換()
　With ActiveCell
　　If .Row > 1 And .Row < 8 And .Column > 0 And .Column < 7 Then
　　　Select Case .Value
　　　　Case 1
　　　　　.Formula = "国"
　　　　Case 2
　　　　　.Formula = "算"
　　　　Case 3
　　　　　.Formula = "社"
　　　　Case 4
　　　　　.Formula = "理"
　　　　Case 12
　　　　　.Formula = "体育"
　　　End Select
　　End If
　End With
End Sub
Sub イベント解除()
　Worksheets(1).OnEntry = ""
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
Private Sub Worksheet_Change(ByVal Target As Range)
　With Target
　　If .Row > 1 And .Row < 8 And .Column > 1 And .Column < 7 Then
　　　Select Case .Value
　　　　Case 1
　　　　　.Formula = "国"
　　　　Case 2
　　　　　.Formula = "算"
　　　　Case 3
　　　　　.Formula = "社"
　　　　Case 4
　　　　　.Formula = "理"
　　　End Select
　　End If
　End With
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
Private Sub Worksheet_Change(ByVal Target As Range)
　Set Target = Intersect(Target, Range("A2:F7")) 　'変数の節約(でれすけさん流)
　If Target Is Nothing Then Exit Sub
　Application.EnableEvents = False
　　With Target
　　　Select Case .Item(1).Value 　'まとめて消したときのため
　　　　Case 1
　　　　　.Value = "国"
　　　　Case 2
　　　　　.Value = "算"
　　　　Case 3
　　　　　.Value = "社"
　　　　Case 4
　　　　　.Value = "理"
　　　End Select
　　End With
　Application.EnableEvents = True
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
このコードは、ミコ作です。初心者丸出しの長いコードだけど、苦労して書いたので載せちゃおっと♪
注意：このマクロは、Enterした時のセルの移動方向によって、コードの内容が変わります。
　　　　不要なコードを削除してください。
Option Explicit
Dim i As Variant, a As Range, b As Range, aa As Long, bb As Long
Dim aaa As Long, bbb As Long
Private Sub Worksheet_Activate()
On Error GoTo TRAP
Set a = Application.InputBox("時間割範囲内の、一番左上のセルをクリックして下さい", _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　"開始セルの選択", Type:=8)
If (a Is Nothing) Then
MsgBox "セルをクリックして下さい"
Exit Sub
End If
Set b = Application.InputBox("時間割範囲内の、一番右下のセルをクリックして下さい", _
  　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　"終了セルの選択", Type:=8)
If (b Is Nothing) Then
MsgBox "セルをクリックして下さい"
Exit Sub
End If
'*** Enterした時、セルの移動方向が横の場合の処理 ***
' aa = a.row
' aaa = b.row
' bb = a.Column + 1
' bbb = b.Column + 1
'*** Enterした時、セルの移動方向が縦の場合の処理 ***
aa = a.row + 1
aaa = b.row + 1
bb = a.Column
bbb = b.Column
Exit Sub
TRAP:
MsgBox "セルを選択してください"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Selection.row < aa Or Selection.row > aaa Or Selection.Column < bb Or Selection.Column > bbb Then
Exit Sub
End If
'*** Enterした時、セルの移動方向が横の場合の処理 ***
'i = Target.Offset(0, -1).Value
'Select Case i
' Case 1
' Target.Offset(0, -1).Value = "国"
'Case 2
' Target.Offset(0, -1).Value = "算"
'Case 3
' Target.Offset(0, -1).Value = "社"
'Case 4
' Target.Offset(0, -1).Value = "理"
'End Select
'With Target.Offset(0, -1)
' .HorizontalAlignment = xlCenter
' .VerticalAlignment = xlCenter
'End With
'*** Enterした時、セルの移動方向が縦の場合の処理 ***
i = Target.Offset(-1, 0).Value
Select Case i
Case 1
Target.Offset(-1, 0).Value = "国"
Case 2
Target.Offset(-1, 0).Value = "算"
Case 3
Target.Offset(-1, 0).Value = "社"
Case 4
Target.Offset(-1, 0).Value = "理"
End Select
With Target.Offset(-1, 0)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
22 ちょっと便利な、時間割入力
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200101/01010021.txt
　　「ユーザー設定のツールバーに、任意の文字列でボタンを登録できますか」　
　　　　【編集ラウンジ】
下のコードを、マクロの使い方(１)標準モジュールの方法でモジュールに書き込み、
それぞれのコードを、ツールバーのアイコンに登録します。
Sub 国()
　With Selection
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　　.FormulaR1C1 = "国"
　End With
End Sub
Sub 算()
　With Selection
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　　.FormulaR1C1 = "算"
　End With
End Sub
Sub 社()
　With Selection
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　　.FormulaR1C1 = "社"
　End With
End Sub
Sub 理()
　With Selection
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　　.FormulaR1C1 = "理"
　End With
End Sub
下のコードを、マクロの使い方(１)標準モジュールの方法でモジュールに書き込み、
それぞれのコードを、ツールバーのアイコンに登録します。
Sub 空白()
　教科入力 ""
End Sub
Sub 国語()
　教科入力 "国"
End Sub
Sub 算数()
　教科入力 "算"
End Sub
Sub 理科()
　教科入力 "理"
End Sub
Sub 社会()
　教科入力 "社"
End Sub
Private Sub 教科入力(ByRef 教科名 As String)
　ActiveCell.Value = 教科名
　SendKeys "{ENTER}"
End Sub
Sub 戻る()
　SendKeys "+{ENTER}"
　DoEvents
　ActiveCell.ClearContents
End Sub
Ａ２からＦ９の範囲で右クリックをする毎に、空白→国→算→社→理→体育→空白と、変化します。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
　Dim myRange As Range
　Set myRange = Range("A2:F9")
　If myRange.Address <> Union(Target, myRange).Address Then Exit Sub
　　If Target.Value = "" Then
　　　Target.Value = "国"
　　ElseIf Target.Value = "国" Then
　　　Target.Value = "算"
　　ElseIf Target.Value = "算" Then
　　　Target.Value = "社"
　　ElseIf Target.Value = "社" Then
　　　Target.Value = "理"
　　ElseIf Target.Value = "理" Then
　　　Target.Value = "体育"
　　ElseIf Target.Value = "体育" Then
　　　Target.Value = ""
　　Else
　　　Target.Value = ""
　End If
　Cancel = True
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
ダブルクリックする毎に、空白→体育→理→社→算→国→空白と変化します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Dim myRange As Range
　Set myRange = Range("A2:F9")
　If myRange.Address <> Union(Target, myRange).Address Then Exit Sub
　　If Target.Value = "" Then
　　　Target.Value = "体育"
　　ElseIf Target.Value = "体育" Then
　　　Target.Value = "理"
　　ElseIf Target.Value = "理" Then
　　　Target.Value = "社"
　　ElseIf Target.Value = "社" Then
　　　Target.Value = "算"
　　ElseIf Target.Value = "算" Then
　　　Target.Value = "国"
　　ElseIf Target.Value = "国" Then
　　　Target.Value = ""
　　Else
　　Target.Value = ""
　End If
　Cancel = True
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
両方のコードをそれぞれの場所に記入します。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
　With Application.CommandBars("Cell")
　　.Reset
　　With .Controls
　　　With .Add
　　　　.BeginGroup = True
　　　　.Caption = "国語"
　　　　.OnAction = "教科入力2"
　　　End With
　　　With .Add
　　　　.Caption = "算数"
　　　　.OnAction = "教科入力2"
　　　End With
　　　With .Add
　　　　.Caption = "理科"
　　　　.OnAction = "教科入力2"
　　　End With
　　　With .Add
　　　　.Caption = "社会"
　　　　.OnAction = "教科入力2"
　　　End With
　　End With
　End With
End Sub
このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。

Public Sub 教科入力2()
　ActiveCell.Value = Left(Application.CommandBars.ActionControl.Caption, 1)
　Application.CommandBars("Cell").Reset
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
23 選択範囲内の、数式はそのままで値のみをクリアしたい
http://www.keep-on.com/~excelyou/2000lng1/200008/00080193.txt
　　「値のみクリアするには？」　【編集ラウンジ】
Excel97、Excel2000 共通
　1.対象となる範囲を選択する。
　2.「編集」-「ジャンプ」の中の「セル選択」をクリックする。
　3.定数をクリックする。（値だけが選択されます）
　4.DELキーを押す。
　　　このコマンドを使えば数式だけ消すとかもできます。
24 複数のセルに分かれた値を、文字列で１つのセルに連結させるには
http://www.keep-on.com/~excelyou/2000lng1/200009/00090092.txt
　　「セルを結合しその中の文字も結合するには」　【編集ラウンジ】
Excel97、Excel2000 共通
　=A1&B1
Excel97、Excel2000 共通
　=CONCATENATE(A1,B1)
最初にシングルコーテーション(')を入れ､& でつなぎます｡
Cells(1, 4) = "'" & Cells(1, 1) & Cells(1, 2) & Cells(1, 3)
25 半角数字を全角にするには、全角数字を半角にするには
http://cgi.fuji.ne.jp/~fj2094/cgi-bin2/wwwlng.cgi?print+200010/00100005.txt
　　「数値を文字列にするには？」　【その他ラウンジ】
Excel97、Excel2000 共通
　=JIS(A1)　　　　半角→全角
　=ASC(A1)　　　 全角→半角
26 クリックでセルのデータを入れ替えるには
Ａ列の、最初に選んだセルと、次に選んだセルの中身が入れ替わります。
シートの一行目の１００〜１０２列のセルをメモ用に使用しています。
もしここが実際に使っているのなら、ほかの空いたセルに替えてください。
　Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
 　 If Target.Column <> 1 Then Exit Sub
　　　If Cells(1, 100) = "" Then
　　　　Cells(1, 100) = Target.Value
　　　　Cells(1, 101) = Target.Row
　　　　Cells(1, 102) = Target.Column
　　　ElseIf Cells(1, 100) <> "" Then
　　　　Cells(Cells(1, 101).Value, Cells(1, 102).Value).Value _
　　　　　　　　= Target.Value
　　　　Target.Value = Cells(1, 100).Value
　　　　Cells(1, 100).ClearContents
　　　End If
　End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
右クリックしたセルと、ダブルクリックしたセルのデータを入れ替えます。
　Public s 　　　　　　　'変数の宣言。sはVariant型
　　Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Cancel = True
　　s = Target.Address(False, False)
　End Sub
　Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Dim s1 As String, mae As Variant, ato As Variant
　　Cancel = True
　　s1 = ActiveCell.Address(False, False)
　　mae = Range(s).Value
　　ato = Range(s1).Value
　　Range(s).FormulaR1C1 = ato
　　Range(s1).FormulaR1C1 = mae
　End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
27 （C)が©になってしまう
http://www.keep-on.com/~excelyou/2000lng1/200007/00070048.txt
　　「（C)を半角英数で入力するには？」　【その他ラウンジ】
Excel97、Excel2000 共通
【ツール】−【オートコレクト】で、入力中にオートコレクトのチェックをはずすか、(c)の項目を削除します。
28 ひとつのセルのデータを複数のセルに分割するには
A1セルの、11223344　というデータを　B1〜E1セルに、11、22、33、44に分割します。
　Sub test()
    　Dim v As Variant
    　v = Cells(1, 1).Value
    　Cells(1, 2).Value = Left(v, 2)
    　Cells(1, 3).Value = Mid(v, 3, 2)
    　Cells(1, 4).Value = Mid(v, 5, 2)
   　 Cells(1, 5).Value = Right(v, 2)
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
29 郵便番号を入力し、郵便番号、住所を表示するには
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200101/01010378.txt
　　「郵便番号を入力すると、隣のセルに住所が表示される」　【ＶＢＡラウンジ】
郵便番号変換ウィザード (Excel 2000 用) 　マイクロソフト ダウンロードセンター
(1)セルA1に、=LEFT(PHONETIC(B1),8)　と入力しておきます。
(2)IMEの変換モードを人名/地名にして、IMEをオン。
(3)セルB1で、郵便番号を入力して住所に変換・確定。
　　セルA1には、セルB1のふりがなとして郵便番号が表示されます。
30 文字列の形式を置き換えます
次のようなデータを用意してから、実行してみてください。
　　　　Ａ１：半角カタカナ　　　　　　Ｂ１：全角カタカナ　　　Ｃ１：ローマ字の小文字
　　　　Ｄ１：ローマ字の大文字　　 Ｅ１：全角ひらがな　 　 Ｆ１：全角カタカナ
　Sub test3()
　　Dim x(1 To 6) As String
　　With Worksheets("Sheet2")
　　　x(1) = StrConv(.Cells(1, 1).Value, vbWide) 　　　　　'半角を全角に
　　　x(2) = StrConv(.Cells(1, 2).Value, vbNarrow) 　　　'全角を半角に
　　　x(3) = StrConv(.Cells(1, 3).Value, vbUpperCase) 　'小文字を大文字に
　　　x(4) = StrConv(.Cells(1, 4).Value, vbLowerCase) 　'大文字を小文字に
　　　x(5) = StrConv(.Cells(1, 5).Value, vbKatakana) 　　'ひらがなをカタカナに
　　　x(6) = StrConv(.Cells(1, 6).Value, vbHiragana) 　　'カタカナをひらがなに
　　　MsgBox x(1) & "　" & x(2) & "　" & x(3) & "　" & x(4) & "　" & x(5) & "　" & x(6)
　　End With
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
StrConv 関数の定数には、次のものがあります。

　　　定　数

値

　　　　　　　　　　　　　　　　内　　　　　　　　容

vbUpperCase

1

 文字列を大文字に変換します。
vbLowerCase 　

2

 文字列を小文字に変換します。
vbProperCase

3

 文字列の各単語の先頭の文字を大文字に変換します。
vbWide　　　　

4

 文字列内の半角文字 (1 バイト) を全角文字 (2 バイト) に変換します。
vbNarrow　 　　

8

 文字列内の全角文字 (2 バイト) を半角文字 (1 バイト) に変換します。
vbKatakana　 　　

16

 文字列内のひらがなをカタカナに変換します。
vbHiragana　　　

32

 文字列内のカタカナをひらがなに変換します。
vbUnicode 　　

64

 システムの既定のコード ページを使って文字列を Unicode に変換します。
vbFromUnicode 　

128

 文字列を Unicode からシステムの既定のコード ページに変換します。
31 ひらがなをカタカナ（半角・全角）に、カタカナ（半角・全角）をひらがなにするには
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200206/02060028.txt　
　「カタカナをかなに変換できますか？」　【編集ラウンジ】
1.　A1:A10にカタカナ文字があるとして、その範囲を選択し、メニューバーで【書式】【ふりがな】【設定】【種類】を
　　ひらがな（または、全角カタカナ、半角カタカナ、）にします。
2.　B1=PHONETIC(A1)　と入力して下へオートフィルでコピーします
3.　B列をコピーして、【編集】【形式を選択して貼り付け】【値】で任意の場所に貼り付けます。
変更したいセル範囲を選択してから下記コードを実行してください。
なお、全角のカタカナや英数も、半角に変換されます。
　Sub 半角カタカナをひらがなに()
　　Dim C As Range
　　If TypeName(Selection) = "Range" Then
　　　For Each C In Selection
　　　　C.Value = StrConv(C.Value, vbWide + vbHiragana)
　　　Next
　　End If
　End Sub
　Sub 半角カタカナを全角カタカナに()
　　Dim C As Range
　　For Each C In Selection
　　　C.Value = StrConv(C.Value, vbWide)
　　Next
　End Sub
　Sub 全角カタカナを半角カタカナに()
　　Dim C As Range
　　For Each C In Selection
　　　C.Value = StrConv(C.Value, vbNarrow)
　　Next
　End Sub
　Sub 全角カタカナをひらがに()
　　Dim C As Range
　　For Each C In Selection
　　　　C.Value = StrConv(C.Value, vbHiragana)
　　Next
　End Sub
　Sub ひらがなを全角カタカナに()
　　Dim C As Range
　　For Each C In Selection
　　　C.Value = StrConv(C.Value, vbKatakana)
　　Next
　End Sub
　Sub ひらがなを半角カタカナに()
　　Dim C As Range
　　For Each C In Selection
　　　C.Value = StrConv(C.Value, vbNarrow + vbKatakana)
　　Next
　End Sub

'シート内の全てのセルを変換する場合
　Sub アクティブなシートの全セルのひらがなを半角カタカナに()
　　Dim rs As Range
　　For Each rs In ActiveSheet.UsedRange
　　　rs.Value = StrConv(rs.Value, vbNarrow + vbKatakana)
　　Next
　End Sub
'ファイル内の全てのシートの全てのセルを対称にする場合、
　Sub 全てのシートの全てのセルのひらがなを半角カタカナに()
　　Dim rs As Range, Sh As Worksheet
　　For Each Sh In Worksheets
　　　Sh.Select
　　　For Each rs In ActiveSheet.UsedRange
　　　　rs.Value = StrConv(rs.Value, vbNarrow + vbKatakana)
　　　Next rs
　　Next Sh
　End Sub

　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
32 文字数が15文字を超えたら残りを隣のセルに入力するには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200103/01030149.txt
　「文字数が15文字を越えたら隣ノセルに入力するには？」　【編集ラウンジ】
Excel97、Excel2000 共通
Ａ１に　文字列を入れるとして、
Ｂ１に　=LEFT(A1,15)
Ｃ１に　=IF(LEN(A1)>15,RIGHT(A1,LEN(A1)-15),"") 　とします。
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
33 文字列から数値だけを抽出するには？
http://www.keep-on.com/~excelyou/2000lng2/200006/00060019.txt
　　「文字列から数字だけを抽出するには？」　【その他ラウンジ】
抽出するデータを選択してから実行します｡元のデータの右隣に数字が抽出されます｡
　Sub test()
    　Dim mydata As String
    　Dim c As Range
    　Dim i As Integer
    　For Each c In Selection
       　 mydata = ""
        　For i = 1 To Len(c)
          　  If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then
            　    mydata = mydata & Mid(c, i, 1)
   　      　End If
       　 Next
       　 c.Offset(0, 1) = mydata
   　 Next
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
34 全角英数カナを半角英数カタカナに一括変換するには
Sub 選択範囲の全角英数カナを半角に()
　Dim rs As Range
　For Each rs In Selection
　　rs.Value = StrConv(rs.Value, vbNarrow)
　Next
End Sub
Sub アクティブなシートの全セルの全角英数カナを半角に()
　Dim rs As Range
　For Each rs In ActiveSheet.UsedRange
　　rs.Value = StrConv(rs.Value, vbNarrow)
　Next
End Sub
Sub 全てのシートの全てのセルの全角英数カナを半角に()
　Dim rs As Range, Sh As Worksheet
　For Each Sh In Worksheets
　Sh.Select
　　For Each rs In ActiveSheet.UsedRange
　　　rs.Value = StrConv(rs.Value, vbNarrow)
　　Next rs
　Next Sh
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
35 Ａ列の漢字のふりがなを、Ｂ列に表示するには？
Excel97、Excel2000、Excel2002 共通
Ｂ１に、　=PHONETIC(A1)　と入力します。
Excel2000、Excel2002確認済
Ａ列に入力した漢字データのふりがなを、Ｂ列以降に表示します。
可能性のある読み方のふりがなをすべて表示しますので、不要な物も出てしまいます。
　Sub test()
　Dim strPhoText As String, LastRow As Long, data As String, i As Long, j As Integer
　LastRow = Cells(Rows.Count, 1).End(xlUp).Row　　　　　　 'A列対象最終行取得
　For i = 1 To LastRow
　　data = Cells(i, 1)
　　strPhoText = Application.GetPhonetic(data)
　　j = 2
　　While strPhoText <> ""
　　　Cells(i, j) = strPhoText
　　　strPhoText = Application.GetPhonetic()
　　　j = j + 1
　　Wend
　Next
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
36 任意の列が変更･削除されたとき、メッセージを出して変更付加にするには
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200107/01070100.txt
　　「変更を加えるとエラー表示が出るようにするには？」　【編集ラウンジ】
Excel2002 確認済み
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 Then　　　　　　　　　　　　　　　　　　　　　'該当するセルが１列目（Ａ列）の場合
    MsgBox "Ａ列のセルの値は、変更・削除できません"
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
  End If
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
37 ダブルクリックで今日の日付を入れたり消したりするには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200107/01070011.txt
　　「データ入力のテクニック教えて!」　【ＶＢＡラウンジ】
Excel2002 確認済み
Ｇ列対象で、ダブルクリックすると今日の日付を入れたり消したりします。
　Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Dim RangeName As String
　　RangeName = Target.Address
　　RangeName = Mid(RangeName, 2, 1)
　　If RangeName = "G" And Target = "" Then
　　　Target = Format(Now, "yyyy/mm/dd")
　　ElseIf RangeName = "G" And Target <> "" Then
　　　Target = ""
　　End If
　　Cancel = True
　End Sub

　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
Excel2002 確認済み
Ｇ列対象で、ダブルクリックすると今日の日付を入れたり消したりします。
　Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Select Case Target.Column
　　　Case 7
　　　　If IsEmpty(Target) Then
　　　　　Target.Value = Date
　　　　Else
　　　　　Target.Value = Empty
　　　　End If
　　　Cancel = True
　　End Select
　End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。
38 数式や関数で参照した場合に、ふりがな情報も参照するには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin2/wwwlng.cgi?print+200104/01040205.txt
　　「ふりがな付きで関数で移送するには？」　【関数ラウンジ】
Excel2000、Excel2002 共通
他のセルの漢字の値を、=A1等で参照すると、ふりがな表示できません。その場合、
=ASC(PHONETIC(A1))&CHAR(10)&A1
として、 全体を折り返して表示します。
39 結合したセルを含む列に、連番を振るには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200107/01070207.txt
　　「結合したセルに連番をふるには？」　【編集ラウンジ】
Ａ列の１行目から３０行目までに、１〜３０までの連番を振ります。
縦のセルが結合されていると行数・連番が変わってきますので、For a = 1 To 30　のところを
調整してください。
　Sub test()
　　Dim a As Long, b As Long
　　b = 1
　　For a = 1 To 30
　　Cells(a, 1) = b
　　If Cells(a, 1) = b Then b = b + 1
　　Next a
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
40 ほかからコピーした漢字のフリガナを表示するには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200101/01010047.txt
　　「ふりがなの一括変換」　【VBAラウンジ】
Excel2000 2002　共通
【書式】【フリガナ】【編集】で、Enterします。
Excel2000 2002　共通
他からコピーしたデータで、フリガナが表示できないセルの漢字に、フリガナを割り当てます。
選択したセル全てを一気に処理。
Sub test1()
　Dim c As Range
　'選択対象がセルでなければ､マクロを中止
　If Not TypeName(Selection) = "Range" Then Exit Sub
　For Each c In Selection '選択したセル全てを処理
　　c.SetPhonetic
　Next
End Sub
Excel2000 2002　共通
他からコピーしたデータでフリガナが表示できないセルにフリガナを割り当て、
間違ったフリガナを、他のフリガナに変更します。
選択したセル全て一気に処理。漢字以外にもすべてフリガナを振ります。
Sub test2()
　Dim c As Range
　'選択対象がセルでなければ､マクロを中止
　If Not TypeName(Selection) = "Range" Then Exit Sub
　For Each c In Selection '選択したセル全てを処理
　　c.Characters(1, Len(Application.GetPhonetic(c.Value))).PhoneticCharacters = Application.GetPhonetic(c.Value)
　Next
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
Excel2000 2002　共通
Ａ列が「氏名」、Ｂ列以降に「ふりがな」の候補を表示します。
　Sub test3()
　　Dim strPhoText As String, LastRow As Long, data As String, i As Long, j As Integer
　　LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'A列対象最終行取得
　　For i = 1 To LastRow
　　　data = Cells(i, 1)
　　　strPhoText = Application.GetPhonetic(data)
　　　j = 2
　　　While strPhoText <> ""
　　　　Cells(i, j) = strPhoText
　　　　strPhoText = Application.GetPhonetic()
　　　　j = j + 1
　　　Wend
　　Next
　End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

HOME　　検索　　索引　　もくじ　　関数目次　　前ページへ　　次ページへ

このページのTOPへ　

　

　

　

　

　

　

　

　

　

　

　

　

　

　　　　

inserted by FC2 system