• ベストアンサー

Alt+Enterでセル内改行された文字をＶＢで認識させるには？

Excel2000です。 例えばＡ１に以下の様にAlt+Enterで改行された文字が書かれている時に IF文を使ってマクロを実行したい場合、???にはどう書けば良いのでしょうか？ ???に、1234Alt+Enter5678　と同じとさせる書き方です。 ┌──┐ │1234│ │5678│ └──┘ Dim 認識 As String 認識 = Cells(1,1).Value IF 認識 = ??? Then ・・・・実行したいマクロ

質問者が選んだベストアンサー

  • ベストアンサー
  • ziziwa1130
  • ベストアンサー率21% (329/1547)
回答No.1

"1234"+Chr(10)+"5678"です。

SHI-UE
質問者

お礼

ありがとうございます。 ＋ですか！　 ＆で動かず悩んでました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (3)

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.4

復帰改行はChr(13) + Chr(10)ですが、同じ意味で vbNewLineという予約定数があります。 以下のように記述してください。 If 認識 = "1234" & vbNewLine & "5678" Then

SHI-UE
質問者

お礼

ありがとうございます。 同じと判断してくれず動かずでした。 最初の方の回答"1234"+Chr(10)+"5678"でいかせて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.3

If InStr(認識, Chr(10)) > 0 Then とか If Replace(認識, Chr(10), "") <> 認識 Then でいかがでしょうか？

SHI-UE
質問者

お礼

ありがとうございます。 最初の方の回答"1234"+Chr(10)+"5678"でいかせて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.2

チェックするのは、セルの中の改行コードです。 If InStr(Range("A1"), vbLf) >= 1 Then Call Macro1 End If http://officetanaka.net/excel/vba/tips/tips89.htm

SHI-UE
質問者

お礼

ありがとうございます。 最初の方の回答"1234"+Chr(10)+"5678"でいかせて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • エクセル2007 参照セルの値が認識されない

    エクセル2007の環境で下記マクロを実行すると、 アクティブシートのセルA1に数字が入っている場合、Sheet1のセルA1に値を転記しても そのセルA1の値をVLOOKUP関数で参照できません。 マクロに問題があるためなのか何処に問題があるのか分からないので教えてください。 宜しくお願いいたします。 【sheet】は アクティブシートの3行目から1000行目までのA列のセルをクリックしたらセルA1に値を表示 その後、下記【モジュール】を使用し、 アクティブシートのセルA1が空白の場合、 A列の数値をSheet1のセルA1に転記し、アクティブシートのA列の数値が空白になるまで循環する。 Sheet1のセルA1の値をVLOOKUP関数で参照した内容を表示、印刷します。 ----------------------------------------------------------------- '【sheet】 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 + IsEmpty(.Value) Then Exit Sub If Application.Intersect(.Cells, Range("A3:A1000")) Is Nothing Then Exit Sub ActiveSheet.Cells(1, 1).Value = .Value End With End Sub ----------------------------------------------------------------- '【モジュール】 Sub TEST() Dim myBtn As Integer Dim myMsg As String, myTitle As String Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Long myMsg = "●●●" myTitle = "確　認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) If myBtn = vbYes Then Set WS1 = ActiveSheet Set WS2 = Sheet1 If WS1.Cells(1, 1).Value = "" Then With WS1 For i = 3 To 65536 If .Cells(i, 1).Value = "" Then Exit For WS2.Cells(1, 1).Value = .Cells(i, 1).Value WS2.Cells(1, 2).Value = ActiveSheet.Name 'WS2.PrintOut Copies:=1 Next i End With ElseIf WS1.Cells(1, 1).Value >= 1 Then WS2.Cells(1, 1).Value = WS1.Cells(1, 1).Value WS2.Cells(1, 2).Value = WS1.Name 'WS2.PrintOut Copies:=1 Else End If End If End Sub -----------------------------------------------------------------

  • Excel（エクセル）のセル内の改行がＡｌｔ＋Ｅｎｔｅｒでできなくなりました。

    いろいろ調べてみたのですがどうしてもわからないので教えてください。 エクセルのセル内の改行をＡｌｔ＋Ｅｎｔｅｒキーで、この前までは改行できていたのですが、急に使えなくなってしまいました。 Ａｌｔキーが無効になっているのかと思い、ユーザ補助のキーボードの設定を見てみたのですが、見てもわかりませんでした。 直す方法などを教えてください。 尚、Windows XP　Excel2000を使用しています。 よろしくお願い致します。

  • エクセルのマクロで複数セル指定は？

    以前（7月22日　質問No.936181）の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル（例えばA1からA30の30個のセル）をいっぺんに書き込むようにしたいのですが可能でしょうか？ よろしくお願いします。

  • VBAにてリストボックスに表示された文字をエクセルのセルにコピペするには

    先日、ここで教えてもらった以下の内容で、幾つかのテキストボックスに表示された内容のうち、電話番号をエクセルのセルに転記する方法が、上手くいきません。”検索"名のシート上で実行します。 過去のログを参考にしましたが、解決できませんでした。 またお世話になりますが、だれか教えてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As UserForm Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Worksheet Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set kensaku = Worksheets("顧客データ") MaxRows = kensaku.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = kensaku.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) .ListBox1.List(.ListBox1.ListCount - 1, 1) = i End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() Dim r As Long With ListBox1 If .ListIndex > -1 Then r = .List(.ListIndex, 1) '選択した名前の行 TextBox6.Value = Worksheets("顧客データ").Cells(r, 3) 'カタカナ名 TextBox2.Value = Worksheets("顧客データ").Cells(r, 5) '漢字名 TextBox3.Value = Worksheets("顧客データ").Cells(r, 7) '住所 TextBox4.Value = Worksheets("顧客データ").Cells(r, 1) '電話番号 TextBox5.Value = Worksheets("顧客データ").Cells(r, 2) '顧客番号 End If End With End Sub Private Sub CommandButton3_Click() 'クリックすると 　Worksheets("検索").Cells(, 2)　’このシートの(G2)に上記の電話番号が入力される End Sub

  • 文字列をバイト数に変換して、設定数よりオーバーしたセルを赤文字にしたい

    文字列をバイト数に変換して、設定数よりオーバーしたセルを赤文字にしたいと思い、下記のマクロを組みました。 しかし、VBAのLen関数は半角も２バイトで計算するとテキスト本に書いているのを読んだのですが、全角は２バイト、半角は１バイトで計算する方法はありますでしょうか？ どなたか教えていただけますと大変助かります。 OSはXP、Excelは2003　を使用しています。 Sub 文字数を調べて色を変える() Dim mojicnt As Integer Dim moji As String Dim maxgyo As Long Dim motogyo As Long maxgyo = Cells(Rows.Count, 1).End(xlUp).Row For motogyo = 2 To maxgyo moji = Cells(motogyo, 2).Value mojicnt = LenB(moji) If mojicnt > 32 Then Cells(motogyo, 2).Font.ColorIndex = 3 End If Next motogyo For motogyo = 2 To maxgyo moji = Cells(motogyo, 4).Value mojicnt = LenB(moji) If mojicnt > 50 Then Cells(motogyo, 4).Font.ColorIndex = 3 End If Next motogyo For motogyo = 2 To maxgyo moji = Cells(motogyo, 5).Value mojicnt = LenB(moji) If mojicnt > 50 Then Cells(motogyo, 5).Font.ColorIndex = 3 End If Next motogyo For motogyo = 2 To maxgyo moji = Cells(motogyo, 8).Value mojicnt = LenB(moji) If mojicnt > 56 Then Cells(motogyo, 8).Font.ColorIndex = 3 End If Next motogyo End Sub 説明不足のところがありましたら、申し訳ありません。 よろしくお願い致します。

  • 下記のマクロをもっと早くするには？

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • VBAtest

    VBAおｎ以下の Sheets("ＯＰ").Select Dim atai As String atai = Cells(2, 2).Value Dim datedata(40) As String For j = 0 To 40 If Cells(j + 3, 2).Value = "" Then Else datedata(j) = Cells(j + 3, 2).Value End If Next Dim shihyou As String For i = 1 To 2 shihyou = Cells(2, i + 2).Cells.Value Sheets(shihyou).Select Dim tmp_c As Integer For r = 1 To 10 tmp_c = 0 For c = 1 To 10 If tmp_c = 0 Then If Sheets(shihyou).Cells(r, c).Value = atai Then tmp_c = c End If Else Dim vals(40) As String For k = 0 To 40 For l = 1 To r + 41 For m = 1 To tmp_c - 1 If Sheets(shihyou).Cells(l, m).Value = datedata(k) Then vals(k) = Sheets(shihyou).Cells(l, tmp_c).Value End If Next Next Next End If Next Next Sheets("ＯＰ").Select For k = 3 To 43 Cells(k, i + 2).Value = vals(k - 3) Next Next End Sub

  • マクロをボタンに登録するとちゃんと走らない

    エクセル２０００で以下のような百人一首のマクロを作ったのですが マクロをボタンに登録すると上の句と下の句の更新が後回しになります 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

  • VBA Do~Loopについて

    VBA勉強中です。 マクロの作成は完了しているのですが、処理効率について指摘を受け、 その際に助言もいただいたのですが、自身の勉強不足、理解不足で どのように変更すれば良いのか分からず、教えていただきたいです。 Do While Ax2 <= 30　で30回繰り返すのではなく (Cells(Ax2,"B").Value <> "" )　の間繰り返すように変更したいです。 ---------------- Sub test() 　Dim File1(30) As string 　Dim Sheet1(30) As string 　Dim Sheet2(30) As string 　Dim Cnt As Integer 　Ax1=1 　Ax2=7 　Do While Ax2 <= 30 　　 If Cells(Ax2, "B").Value <> "" Then 　　　 File1(Ax1) = Cells(Ax2, "B").Value 　　　 Sheet1(Ax1) = Cells(Ax2, "C").Value 　　　 Sheet2(Ax1) = Cells(Ax2, "D").Value 　　　 Cnt =Ax1 　　 End If 　　 Ax1 = Ax1 + 1 　　 Ax2 = Ax2 + 1 　Loop End Sub ---------------- お手数ですが、よろしくお願いいたします。

  • １つのPCで同じマクロを複数動かす

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロで、いろんなURLを調べる作業があります。 その作業を早く完了させるために、下記のマクロを同時に動かそうと思っています。 しかし、エクセルを使えるPCが１つしかありません。 エクセルを２つ起動して、調べるURLを分けて、 ２つのエクセルでマクロを同時に動かす。 これをやろうと思いましたが、かなりPCが重くなるし、 エクセルが度々フリーズしたみたいになります。 どうにか、１つのPCで下記のマクロを複数動かして、 いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか？ エクセル2016です。 よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する