- ベストアンサー
Chr関数であいうえお順に
Chr関数であいうえお順に文字をエクセルに書き出そうとしたけど、 単純にはいかないのですかね？ Sub test() Dim MyRow As Long Dim i As Long For MyRow = 1 To 51 Cells(MyRow, 1) = Chr(-32096 + i) i = i + 2 Next MyRow End Sub これを実行すると、濁点が入ったりするのですが、 綺麗に「あ～ん」まで取得する方法はありますか？ 複雑なコードを作るしかないのですかね？
- zzdwyzqzwusnd
- お礼率100% (49/49)
- その他MS Office製品
- 回答数4
- ありがとう数4
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
Chr(-32096 + i) を Mid("あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", i, 1) あたりに変えればできませんかね？ 文字列部分は別途変数に入れて分離しても可です。
その他の回答 (3)
- K Kazz（@JazzCorp）
- ベストアンサー率31% (549/1751)
力仕事で、、、 Sub あいうえお() Const あ As Integer = &H82A0 Const 削除行 = "77,66,60,59,57,56,54,53,51,50,48,47,40,38,36,34,33,31,29,27,25,23,21,19,17,15,13,11,8,6,4,2" Dim Delrow As Variant Dim kk As Long Dim nn As Long ActiveSheet.UsedRange.ClearContents For nn = 1 To 82 Cells(nn, "A") = Chr(あ + nn - 1) Next Cells(70, "A") = "" Cells(68, "A") = "" Rows(80).Insert Delrow = Split(削除行, ",") For kk = LBound(Delrow) To UBound(Delrow) nn = Delrow(kk) Rows(nn).Delete Next End Sub
お礼
ありがとうございました。
- nicotinism
- ベストアンサー率70% (1019/1452)
Sub a() Dim i As Integer For i = 177 To 221 Cells(i - 176, 1) = StrConv(Chr(i), vbHiragana + vbWide) Next End Sub こんなのとか・・ や行とわ行がアレかもしれない。
お礼
ありがとうございました。
- bin-chan
- ベストアンサー率33% (1403/4213)
Web用PCにExcel入れてないので試せてませんが。 半角カナをループで生成して、JIS関数で全角にするとどうなります？
お礼
ありがとうございました。
関連するQ&A
- 文字コードに対応する文字が振られていないの？
windows7を使っています。 エクセルVBAで Sub Sample1() Dim i As Long Dim myRow As Long For i = -32768 To 32767 myRow = myRow + 1 Cells(myRow, 1) = Chr(i) Next i End Sub のコードで文字コードをすべて書き出してみたのですが 空白や「」だけ等がいくつもあります。 これはどうしてでしょうか? 文字コードに対応する文字が振られていないのでしょうか? -32768 To 32767の理由は Asc 関数のヘルプを見たら 「DBCS を使用しているシステムでは、 -32768 ~ 32767 の範囲の値が返されます。」 となっていた為です。
- ベストアンサー
- Excel（エクセル）
- InternetExplorer.Applicat
Sub test1() Dim objIE As Object Dim i As Long Dim MyRow As Long Dim Str As String Dim tmp As Variant Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "http://oshiete.goo.ne.jp/" objIE.Visible = True Do While objIE.Busy = True DoEvents Loop Str = objIE.Document.Body.innerHTML 'ソースを抜き出す tmp = Split(Str, Chr(10)) '配列に格納する MyRow = 1 '初期値 For i = LBound(tmp) To UBound(tmp) Cells(MyRow, 1) = tmp(i) MyRow = MyRow + 1 Next i objIE.Quit Set objIE = Nothing End Sub ************************************************** Sub test2() Dim objIE As Object Dim Str As String Dim tmp As Variant Dim i As Long Dim MyRow As Long Set objIE = CreateObject("MSXML2.XMLHTTP") objIE.Open "GET", "http://oshiete.goo.ne.jp/", False objIE.Send Str = objIE.responseText 'ソースを抜き出す tmp = Split(Str, Chr(10)) '配列に格納する MyRow = 1 '初期値 For i = LBound(tmp) To UBound(tmp) Cells(MyRow, 1) = tmp(i) MyRow = MyRow + 1 Next i Set objIE = Nothing End Sub ************************************************** 上記の二つのコードは どちらもＶＢＡでHTMLソースをエクセルに書き出すコードなのですが 結果が違います。 なぜなのでしょうか？ 実際のソースを確認したら CreateObject("MSXML2.XMLHTTP") の方が正しかったです。 CreateObject("InternetExplorer.Application") は何が取得されてるのでしょうか？
- ベストアンサー
- Visual Basic
- 「'」もascで変換させたい
Ａ１に「'test」と入れると「test」になってしまいます。 そして、 Sub test() Dim MojiInt As Long Dim i As Long Dim myRow As Long Dim Moji As String MojiInt = Len(Cells(1, 1)) For i = 1 To MojiInt Moji = Mid((Cells(1, 1)), i, 1) If i = 1 Then Cells(1, 2) = Asc(Moji) Else Cells(1, 2) = Cells(1, 2) & "," & Asc(Moji) End If Next i End Sub をすると、 116,101,115,116 になります。 最初の「'」もascで変換させることは無理なのでしょうか？
- ベストアンサー
- その他MS Office製品
- プロシージャー名を変数にはできない？
シートに test1 test2 test3 として、 -------------------------------- Sub Sample() Dim myRow As Long Dim procedure As String For myRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row procedure = Cells(myRow, 1) Call procedure Next myRow End Sub Sub test1() End Sub Sub test2() End Sub Sub test3() End Sub -------------------------------- こういう事ってできないのでしょうか？ シートの文字を読み取ってプロシージャーを実行できれば、順番変えたり、要らないプロシージャーを消したりを、シート上で管理できるから楽なのになと思ったのですが。 これをやろうとすると、procedureというプロシージャーがないから Sub、Function、または Property が必要です。 になってしまいます。
- ベストアンサー
- オフィス系ソフト
- chr関数の戻り値について質問です。
chr関数を使用して、バイナリレベルで自由なデータを、ファイルに出力したいと思っていますが、一部のデータがうまくいきません。 たとえば以下のようなコードを実行して、バイナリエディタで中身を見てみると、0x81～0x9Fと0xE0～0xFCまでが全て、0x00に変換されて出力されています。 Dim i As Long Dim binHex As String Open fileName For Binary As #1 For i = 0 To 255 binHex = Chr(i) Put #1, , binHex Next 0x81等をファイルに書き込む良い方法は無いでしょうか？ 詳しい方、アドバイスをお願いいたします。
- ベストアンサー
- Visual Basic
- VBAトラブル
Sub 百人一首一番から二十番() Dim hyakuSh As Worksheet Dim mySh As Worksheet Set mySh = Worksheets("百人一首クイズ") Set hyakuSh = Worksheets("百人一首") Dim myRow As Integer Randomize myRow = Int((21 - 2 + 1) * Rnd + 2) Dim kaminoku As String Dim kaminoku2 As String Dim kaminoku3 As String Dim simonoku As String Dim simonoku1 As String Dim sakusha As String kaminoku = hyakuSh.Cells(myRow, 3).Value kaminoku2 = hyakuSh.Cells(myRow, 4).Value kaminoku3 = hyakuSh.Cells(myRow, 5).Value shimonoku = hyakuSh.Cells(myRow, 6).Value shimonoku1 = hyakuSh.Cells(myRow, 7).Value sakusha = hyakuSh.Cells(myRow, 8).Value mySh.Activate mySh.Shapes("Text Box 2").Select Selection.Characters.Text = kaminoku & Chr(10) & kaminoku2 & Chr(10) & kaminoku3 Dim MyTBox As Integer Dim smRow As Integer Dim smRow2 As Integer Dim smRow3 As Integer Dim smRow4 As Integer Dim smRow5 As Integer Dim i As Integer mySh.Shapes(2).Select Randomize smRow5 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow5, 6).Value & Chr(10) & hyakuSh.Cells(smRow5, 7).Value & Chr(10) & hyakuSh.Cells(smRow5, 8).Value mySh.Shapes(3).Select Randomize smRow = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow, 6).Value & Chr(10) & hyakuSh.Cells(smRow, 7).Value & Chr(10) & hyakuSh.Cells(smRow, 8).Value mySh.Shapes(4).Select Randomize smRow2 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow2, 6).Value & Chr(10) & hyakuSh.Cells(smRow2, 7).Value & Chr(10) & hyakuSh.Cells(smRow2, 8).Value mySh.Shapes(5).Select Randomize smRow3 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow3, 6).Value & Chr(10) & hyakuSh.Cells(smRow3, 7).Value & Chr(10) & hyakuSh.Cells(smRow3, 8).Value mySh.Shapes(6).Select Randomize smRow4 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow4, 6).Value & Chr(10) & hyakuSh.Cells(smRow4, 7).Value & Chr(10) & hyakuSh.Cells(smRow4, 8).Value Randomize MyTBox = Int((6 - 2 + 1) * Rnd + 2) mySh.Shapes(MyTBox).Select Selection.Characters.Text = shimonoku & Chr(10) & shimonoku1 & Chr(10) & sakusha mySh.Shapes("Text Box 2").Select Dim Ans As Integer Ans = InputBox(hyakuSh.Cells(myRow, 3).Value & hyakuSh.Cells(myRow, 4).Value & hyakuSh.Cells(myRow, 5).Value & Chr(10) & Chr(10) & "下の句を番号で答えなさい", Title:="百人一首", Xpos:=7500, Ypos:=2500) If Ans = MyTBox Then MsgBox " 正解!!! V(・ o ・)V " Else MsgBox ("間違いです!!!!!!!!" & Chr(10) & Chr(10) & hyakuSh.Cells(myRow, 6).Value & hyakuSh.Cells(myRow, 7).Value & Chr(10) & Chr(10) & sakusha & "です") End If End Sub 以上のマクロをエクセルで作ったのですが、VBE～マクロを走らせると順調に走るのですが、マクロをボタンに登録すると、Inputbox に解答を掘り込んであげないと、kaminokuもshimonokuもあたらしいものになりません 今マクロはシート上にあります、マクロを標準モジュールに移しても同じ結果です。何か解決策はありますか? かなり古くエクセル2000です、初心者なので難しいこことはわかりませんが、よろしくお願いします。
- 締切済み
- Visual Basic
- 複数行にまたがっているデーターを一つの行に 2
前の質問を元にVBAを改造をしています。 （前の質問のURL:http://okwave.jp/qa/q8189711.html) 改造したものが以下です。 Sub sample() Dim OWS As Worksheet, NWS As Worksheet Dim myKey As String, myRow As Long, TRow As Long Dim i As Long, j As Long Application.DisplayAlerts = False For Each NWS In Worksheets If NWS.Name = "結果" Then NWS.Delete Next Set OWS = Sheets("Sheet1") Set NWS = Worksheets.Add NWS.Name = "結果" For i = 1 To OWS.Cells(Rows.Count, 1).End(xlUp).Row myKey = OWS.Cells(i, 1) & OWS.Cells(i, 2) For j = 5 To OWS.Cells(i, Columns.Count).End(xlToLeft).Column myKey = myKey & OWS.Cells(i, j) Next j myRow = WorksheetFunction.CountA(NWS.Columns("A:A")) + 1 If NWS.Columns("E:E").Find(What:=myKey, LookAt:=xlWhole) Is Nothing Then NWS.Cells(myRow, 1) = OWS.Cells(i, 1) NWS.Cells(myRow, 2) = OWS.Cells(i, 2) NWS.Cells(myRow, 3) = OWS.Cells(i, 3) NWS.Cells(myRow, 4) = OWS.Cells(i, 4) NWS.Cells(myRow, 5) = myKey Else TRow = NWS.Columns("E:E").Find(What:=myKey, LookAt:=xlWhole).Row NWS.Cells(TRow, 3) = NWS.Cells(TRow, 3) & "," & OWS.Cells(i, 3) NWS.Cells(TRow, 4) = NWS.Cells(TRow, 4) & "," & OWS.Cells(i, 4) End If Next i Call 同一項目削除 NWS.Columns("E:E").Delete Application.DisplayAlerts = True End Sub Sub 同一項目削除() Dim a, myDic, x Dim h As Range Set myDic = CreateObject("Scripting.Dictionary") On Error Resume Next ' Range("A:A").ClearContents For Each h In Range("E1:E" & Range("E65536").End(xlUp).Row) a = Split(Replace(h, " ", " "), ",") For Each x In a myDic.Add x, "," Next h.Offset(0, 0) = Join(myDic.keys, ",") myDic.RemoveAll Next End Sub これをコンパクトにできますでしょうか？
- ベストアンサー
- オフィス系ソフト
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- 質問No.2259731で教えて頂いたコードを訳して欲しい
昨日質問し、回答を頂いたものです。 もう少しで作業が上手くいきそうなのですが 教えて頂いたコードの各工程の意味（処理）がわからず 止まっています。 一つずつ調べてはいますが、かなり時間がかかっていて とても今日中に終わりそうになくて焦っています。 急いでいるもので、すいませんがどなたか下のコードの各行が どのような意味か、訳をつけて頂けないでしょうか。 Sub Test() Dim myCol As Integer, myVal Dim LRow As Long, myRow As Long With ActiveSheet LRow = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row For myCol = .Range("IV1").End(xlToLeft).Column To 3 Step -1 myVal = 0 myRow = .Cells(65536, myCol).End(xlUp).Row If myRow = 1 Then .Columns(myCol).Delete Else Do While myRow > 1 And .Cells(myRow, myCol).Value <> "●" myVal = myVal + .Cells(myRow, myCol).Value myRow = myRow - 1 Loop .Cells(LRow, myCol) = myVal End If Next myCol End With End Sub ちなみに元の質問内容は http://oshiete1.goo.ne.jp/kotaeru.php3?q=2259731 です。
- ベストアンサー
- オフィス系ソフト
- マクロをボタンに登録するとちゃんと走らない
エクセル２０００で以下のような百人一首のマクロを作ったのですが マクロをボタンに登録すると上の句と下の句の更新が後回しになります VBEを開いたままマクロを実行すると上の句下の句を更新したあとに 解答用のinputboxがちゃんと先に出てきます。 何か解決方法はありますか？ マクロを作ったのは初めてに近いです あとマクロコードを2行にするのが出きるときと出来ない時があるのは 何故でしょう。同じように _ アンダーバーを入れて改行してるのですが エラーになります。改行して良い所と悪い所があるのですか 教えて欲しいです。 Sub 百人一首一番から二十番() Dim hyakuSh As Worksheet Dim mySh As Worksheet Set mySh = Worksheets("百人一首クイズ") Set hyakuSh = Worksheets("百人一首") Dim myRow As Integer Randomize myRow = Int((21 - 2 + 1) * Rnd + 2) Dim kaminoku As String Dim kaminoku2 As String Dim kaminoku3 As String Dim simonoku As String Dim simonoku1 As String Dim sakusha As String kaminoku = hyakuSh.Cells(myRow, 3).Value kaminoku2 = hyakuSh.Cells(myRow, 4).Value kaminoku3 = hyakuSh.Cells(myRow, 5).Value shimonoku = hyakuSh.Cells(myRow, 6).Value shimonoku1 = hyakuSh.Cells(myRow, 7).Value sakusha = hyakuSh.Cells(myRow, 8).Value mySh.Activate mySh.Shapes("Text Box 2").Select Selection.Characters.Text = kaminoku & Chr(10) & kaminoku2 & Chr(10) & kaminoku3 Dim MyTBox As Integer Dim smRow As Integer Dim smRow2 As Integer Dim smRow3 As Integer Dim smRow4 As Integer Dim smRow5 As Integer Dim i As Integer mySh.Shapes(2).Select Randomize smRow5 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow5, 6).Value & Chr(10) & hyakuSh.Cells(smRow5, 7).Value & Chr(10) & hyakuSh.Cells(smRow5, 8).Value mySh.Shapes(3).Select Randomize smRow = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow, 6).Value & Chr(10) & hyakuSh.Cells(smRow, 7).Value & Chr(10) & hyakuSh.Cells(smRow, 8).Value mySh.Shapes(4).Select Randomize smRow2 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow2, 6).Value & Chr(10) & hyakuSh.Cells(smRow2, 7).Value & Chr(10) & hyakuSh.Cells(smRow2, 8).Value mySh.Shapes(5).Select Randomize smRow3 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow3, 6).Value & Chr(10) & hyakuSh.Cells(smRow3, 7).Value & Chr(10) & hyakuSh.Cells(smRow3, 8).Value mySh.Shapes(6).Select Randomize smRow4 = Int((51 - 2 + 1) * Rnd + 2) Selection.Characters.Text = hyakuSh.Cells(smRow4, 6).Value & Chr(10) & hyakuSh.Cells(smRow4, 7).Value & Chr(10) & hyakuSh.Cells(smRow4, 8).Value Randomize MyTBox = Int((6 - 2 + 1) * Rnd + 2) mySh.Shapes(MyTBox).Select Selection.Characters.Text = shimonoku & Chr(10) & shimonoku1 & Chr(10) & sakusha mySh.Shapes("Text Box 2").Select Dim Ans As Integer ＊以下の部分が先に出てきて答えを入れないと上のコードが実行されない＊ ＊＊＊＊ここ一行で書いてあるので見にくい部分＊＊＊＊＊＊＊ Ans = InputBox(hyakuSh.Cells(myRow, 3).Value & hyakuSh.Cells(myRow, 4).Value & hyakuSh.Cells(myRow, 5).Value & Chr(10) & Chr(10) & "下の句を番号で答えなさい", Title:="百人一首", Xpos:=7500, Ypos:=2500) ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ If Ans = MyTBox Then MsgBox " 正解!!! V(・ o ・)V " Else MsgBox ("間違いです!!!!!!!!" & Chr(10) & Chr(10) & hyakuSh.Cells(myRow, 6).Value & hyakuSh.Cells(myRow, 7).Value & Chr(10) & Chr(10) & sakusha & "です") End If End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございました。