• ベストアンサー

EXCEL VBA：結合セルのデータを取り出すには？

結合セルに書き込まれている文字列を取得したいのですが、 何か良い方法はありますか？ 以下のような方法をとってみたのですが、 イマイチうまくいきませんでした。。。 Dim iRow as Integer Dim strData as String iRow = 1 strData = Cells(iRow, 1).MergeArea.Value どなたかご教授頂けないでしょうか？ 何卒よろしくお願いします。

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

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

MergeAreaで取得したセルの位置を特定しないといけませんね 通常は結合セルの先頭のみのデータが対象でしょうから strData = Cells（iRow,i).MergeArea( 1, 1).Value といった具合でしょう iRowの更新は iRow = iRow + Cells（iRow,i).MergeArea.Rows.Count といった具合でしょう

pureone
質問者

お礼

なるほど！この書式で取得できるんですね！ ありがとうございました！

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

適当に、複数箇所のセル結合してあるセル範囲をカバーして、範囲指定し、下記を実行してみてください。 Sub test02() Dim cl As Range For Each cl In Selection If cl.MergeCells = True Then If cl.Value <> "" Then MsgBox cl.Address & " " & cl.Value End If End If Next End Sub で無駄なくつかめると思います。

pureone
質問者

お礼

ご回答ありがとうございます。 ちょうど、結合セルのアドレス全てを配列に格納しようかと 考えておりましたので、是非この方法を使わせて頂きます！

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • エクセル　VBA　If～Then～Else

    エクセルのA列に以下の文字列が入っています。 A1 A2＝100-101 A3=102-103 A4=104-105 A5=106-107 A列の文字列を上から順に結合するため下記のVBAを実行しました。 結合の条件として、文字列の最後の数字と次のセルの最初の数字が連続しているならば、互いに消去して結合、そうでないなら「,」 (カンマ)でつなげて結合したいと思っています。 なので期待する結果としては A1=100----107 となってほしいのですが、実際は A1＝100--103,104-105,106-107 となってしまいました。 (ループ中の1回目の条件分岐だけが成功し、２回目以降は違っている) 「IF～Then」の部分が間違っているようなのですが・・・・・わかりません。 プロパティの使い方など全体的に至らぬ点があるかもしれませんがよろしくお願いします。 Dim i As Integer Dim X As String Dim mojisu As String i = 3 X = Cells(i, 1) mojisu = 3 Cells(1, 1) = Cells(2, 1) Do Until Cells(i, 1).Value = "" If Left(X, mojisu) - Right(Cells(1, 1), mojisu) = 1 Then Cells(1, 1).Value = Left(Cells(1, 1), Len(Cells(1, 1)) - mojisu) & Right(X, Len(X) - mojisu) Else Cells(1, 1).Value = Cells(1, 1).Value & "," & Cells(i, 1).Value End If i = i + 1 Loop

  • エクセルマクロでセルの結合をしたい

    エクセル2003です。 E列の値は昇順で並んでいます。 先頭E3行から下の行の値と比較し 同じ値の場合はセルを結合し 値が違う場合は結合しないで次の行を比較という処理を 最終行まで行いたいです。 （添付画像参照） 例えば E3-AA E4-BB E5-BB E6-CC E7-DD E8-EE E9-EE E10-EE E11-FF セルE4とE5を結合します セルE8とE9とE10を結合します。 次に結合した行と同じ行数のF列を結合します。 さらに結合した行と同じ行数のG列を結合します。 上記の場合 セルF4とF5を結合、 セルF8とF9とF10を結合します。 セルG4とG5を結合、 セルG8とG9とG10を結合します。 さらに結合した行と同じ行数のA列を結合します。 上記の場合 セルA4とA5を結合、 セルA8とA9とA10を結合します。 さらに結合したA列に数字を入力します A4とA5を結合したA4、A5セルには 2行を結合したので２と入力 セルA8とA9とA10を結合したA8、A9、A10セルには 3行を結合したので３と入力。 とりあえず、E列の結合を完成させてそのE列を 3行目から最終行までコピーして、 「形式を選択して貼付」の「書式」で 書式のみをF,G,A列にコピーすれば出来るのではと 以下の構文を作成しました。 セルの結合時は結合するセルの先頭の行の値が結合済セルの値に なるので最初にE列を結合していく時に A列に結合回数を記入しようと考えました。 ただ2行の結合は、A列に2と入力されたのですが 3行連結した時も２と入力されてしまったので改造しました。 テストデータでは期待しているようになったのですが 本番データでは結合される行が4行、5行等それ以上の行数が 結合する場合が有りこの構文ではなるべくしてなっているのですが ４行以上の行結合はA列の値はいずれも３になってしまいます。 （添付画像参照） どう修正すればいいか手段が考え付きません。 どのような方法がありますでしょうか？ よろしくお願いします。 Sub セル結合2() '2013年10月25日 Dim 最終行 As Integer Dim 処理行 As Integer Dim 比較行 As Integer Dim 確認値 As Variant Dim 比較値 As Variant Dim 結合回数 Dim 戻行 Application.ScreenUpdating = False ThisWorkbook.Sheets("Sheet1").Select 最終行 = Cells(Rows.Count, 5).End(xlUp).Row 'F列の最終行を求めます。 Application.DisplayAlerts = False For 処理行 = 3 To 最終行 '3行目から最終行の前まで繰り返します。 比較行 = 処理行 + 1 '処理行の一つ下の行と比較します。→比較行とします。 確認値 = Cells(処理行, 5).MergeArea(1, 1).Value 'チェックする値を、確認値に代入します。 比較値 = Cells(比較行, 5) '比較する値を、比較値に代入します。 If 確認値 = 比較値 Then '値が同じかどうか Range(Cells(比較行, 5), Cells(処理行, 5)).MergeCells = True 結合回数 = Cells(処理行, 1) + 1 'セルを結合した回数 戻行 = 処理行 - 1 '処理行の1行上の行数を戻行とする Cells(処理行, 1) = 結合回数 '処理行のA列に結合回数を記入 Cells(比較行, 1) = 結合回数 '比較理行のA列に結合回数を記入 If Cells(処理行, 1) >= 3 Then 'もしも処理行のA列が3以上の場合 Cells(戻行, 1) = 結合回数 '戻り行のA列に結合回数をセット End If '同じでない場合は以下へ End If '同じでない場合は以下へ Next 処理行 Application.DisplayAlerts = True Application.ScreenUpdating = True Range(Cells(3, 5), Cells(最終行, 5)).Copy Range(Cells(3, 6), Cells(最終行, 6)).PasteSpecial Paste:=xlPasteFormats Range(Cells(3, 7), Cells(最終行, 7)).PasteSpecial Paste:=xlPasteFormats Range(Cells(3, 1), Cells(最終行, 1)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False MsgBox "終了しました" End Sub

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

    以前（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の得意な方、教えてください(初心者です)

    エクセルのシートが セルA1に1 セルA2に2 セルA3に3 セルA4に4 セルA5に5 という数字が入っています。 で、セルD4には"=D2*5"という数式が入っています。 セルD2にA1の数値を代入して、出てきた数値をB1に入力、 次にD2にA2の数値を代入して、出てきた数値をB2に入力…以下続く というのをVBAで書いてみたら、下のような感じになりました。 Sub test() Dim d1 As Integer Dim d2 As Integer Dim d3 As Integer Dim d4 As Integer Dim d5 As Integer Dim p1 As Integer Dim p2 As Integer Dim p3 As Integer Dim p4 As Integer Dim p5 As Integer d1 = Cells(1, 1).Value Cells(2, 4).Value = d1 p1 = Cells(4, 4).Value Cells(1, 2).Value = p1 d2 = Cells(2, 1).Value Cells(2, 4).Value = d2 p2 = Cells(4, 4).Value Cells(2, 2).Value = p2 d3 = Cells(3, 1).Value Cells(2, 4).Value = d3 p3 = Cells(4, 4).Value Cells(3, 2).Value = p3 d4 = Cells(4, 1).Value Cells(2, 4).Value = d4 p4 = Cells(4, 4).Value Cells(4, 2).Value = p4 d5 = Cells(5, 1).Value Cells(2, 4).Value = d5 p5 = Cells(4, 4).Value Cells(5, 2).Value = p5 End Sub ここで質問です。 例では5個しかないのですが、実際は100行くらいのデータなんで 大変です。もっと簡単にする方法はありますか？ 実際のセルD4の数式は、他からも参照したりしているので、 ここはいじらずに教えてください。 Excel2000、Visual Basic 6.0 ってのを使っています。 よろしくお願いいたします。

  • エクセルVBA 配列の書き方とセルへの一括表示方法

    エクセルのVBAで 下記のようなプログラムを作成しています。 1行目はタイトル行で E列が空白になるまで、 各行のE列～H列の値を変数に入れて、 最後に一括で別の列・行にそれぞれの値を表示・書込したいと思ってますが、 どうもVBAは初めてでよくわかりません。 Dim aaa As String Dim bbb As String Dim ccc As String Dim eee As Double intRow = 2 Do Until Cells(intRow, 5).Value = "" aaa = Cells(intRow, 5).Value) bbb = Cells(intRow, 6).Value) ccc = Cells(intRow, 7).Value) ddd = Cells(intRow, 8).Value) intRow = intRow + 1 Loop aaaの各変数を2行目のA1～intRowまで bbbの各変数を2行目のB1～intRowまで cccの各変数を2行目のC1～intRowまで dddの各変数を2行目のD1～intRowまで セルに一括して表示したいのです。 配列の書き方と、セルの範囲に表示・書込する方法を どうかご教示下さい。お願いいたします。

  • VBAでのデータ転記（再）

    データがsheet1に縦記述で書いてあります。 C列　D列 ああ　A01 いい　A02 うう　A03 . ささ　B01 しし　B02 すす　B03 . はは　AA01 ひひ　AA02 ふふ　AA03 . やや　AB01 ゆゆ　AB02 よよ　AB03 . D列を元にしてC列の文字列をsheet2に以下のように並べたいです。D列はアドレス扱いででアルファベットが変わったら改行してデータを並べるようにします。 A列　　B列　C列 ああ　いい　うう・ ささ　しし　すす・ ・・・・・ はは　ひひ　ふふ・ やや　ゆゆ　よよ・ 作成したコード Dim I As Integer, MAE As String, IMA As String, TEMP2 As String Dim X1 As Integer, Y1 As Integer, X3 As Integer, Y3 As Integer, PINNAME As String X1 = 4: Y1 = 2 X3 = 1: Y3 = 1 MAE = Sheets("Sheet1").Cells(Y1, X1) Do PINNAME = Sheets("Sheet1").Cells(Y1, X1 - 1) IMA = Sheets("Sheet1").Cells(Y1, X1) '今の値が入っている If IMA = "" Then Exit Do End If If Left(MAE, 1) <> Left(IMA, 1) Then Y3 = Y3 + 1: X3 = 1 Sheets("Sheet2").Cells(Y3, X3).Value = PINNAME X3 = X3 + 1 Else Sheets("Sheet2").Cells(Y3, X3).Value = PINNAME X3 = X3 + 1 End If MAE = Sheets("Sheet1").Cells(Y1, X1) Y1 = Y1 + 1 Loop Until IMA = "" Left関数でアドレスの左1文字を前後のセルで比較して異なる場合、改行する方法を考えましたが、AA01　AA02・・・がムリです。このコードに補足すればできるでしょうか？それとも別の考え方で行った方がいいでしょうか？ 初心者レベルなので考え方も教えて下さい。宜しくお願いします。

  • VBA シート間の単一セルから結合セルへのコピー

    マクロについてご教授をお願いします。 ◆実現したい事 2枚のシート（XとY）が存在します。 コピー元：Xシート　　　　　　　　　　コピー先：Yシート 　　　B列　　　　　　　　　　　　　　　　　　　　B列 1行　商品１　　　コピペ→　　　　　１～３行結合　商品１　 2行　商品２　　　コピペ→　　　　　４～５行結合　商品２ 3行　商品３　　　コピペ→　　　　　６～８行結合　商品３ 　　・　　　　　　　　　　　　　　　　　　　　・ 　　・　　　　　　　　　　　　　　　　　　　　・ 　　・　　　　　　　　　　　　　　　　　　　　・ 　最終行　　　　　　　　　　　　　　　　　　最終行 XシートのB列に1行ずつ、商品名が羅列されています。 YシートのB列には、3行結合（B1:B3)、（B4:B6)、（B7:B9)・・・空白セルがあります。 Xシートの商品名をYシートの結合セルにマクロを使って処理したいです。 ◆試した事 (1)結合を解除し、XからYへ範囲コピーしたが、YのB列に再び、商品毎に2行追加し、結合 　2行追加する方法がわからず断念 (2).valueでXシートB1　＝　YシートB1を試みるができない ◆ここで詰まってます＞＜ Dim X As Worksheet Dim Y As Worksheet Dim 最終行1 As Long Dim 最終行2 As Long Dim cp1 As Long・・・・Yシート行変数 Dim cp2 As Long・・・・Xシート行変数 Set X = Worksheets(1) Set Y = Worksheets(2) 最終行1 = Cells(Rows.Count, 2).End(xlDown).row 最終行2 = Cells(Rows.Count, 2).End(xlDown).row For cp1 = 1 To 最終行１ For cp2 = 1 To 最終行2 Step 3 sh1.Cells(cp1, 2).Copy Destination:= sh2.Cells(cp2, 2) Next Next みたいな感じにできればと、Copyを.valueなどにしてみたりと試してみましたが、 なかなかうまくいかず、3日くらい悩んでいます。 シンプルにやりたいのですが、なにか良い方法などあれば、 ご教授のほどお願い致します＞＜

  • ＥＸＣＥＬ　ＶＢＡ　データのある範囲の特定が悪い？　　

    アンケート調査票を簡単につくために、下のようなマクロを教えていただいたのですが、もとデータ項目の参照範囲がセルのＢ５より上にあるもの（空白の場合も）も項目としてしまっているようなので、どこを手直しすればいいのか、すみませんが教えてください。 Sub test() '定数の設定 Const strInputSheet As String = "Sheet1" Const lngInputRow As Long = 5 Const lngInputCol As Long = 2 Const strOutputSheet As String = "Sheet2" Const lngOutputCol As Long = 3 Const lngOutputRow As Long = 4 Const strMessageA As String = " は " Const strMessageB As String = " に対してどの位影響があると思いますか？" '定義 Dim lngMaxRow As Long Dim lngCountA As Long Dim lngCountB As Long Dim strA As String Dim strB As String Dim lngRow As Long '項目数を把握 Sheets(strInputSheet).Select Cells(ActiveSheet.Rows.Count, lngInputCol).Select Selection.End(xlUp).Select lngMaxRow = Selection.Row 'Ｂ列のデータ最終行を取得 lngRow = lngOutputRow '出力開始行の設定 '項目Aをなめる For lngCountA = lngInputRow To lngMaxRow 　strA = Cells(lngCountA, lngInputCol).Value '項目Aの取得 　'項目Bをなめる 　For lngCountB = 1 To lngMaxRow 　　If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない 　　　strB = Cells(lngCountB, lngInputCol).Value '項目Bを取得 　　　Sheets(strOutputSheet).Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合 　　　lngRow = lngRow + 1 '改行する 　　End If 　Next lngCountB Next lngCountA End Sub

  • VBA　Excelのセル検索

    VBAで以下の要領でセルの検索をしています。 ------------------------------------------- dim getCell As String dim inputStr As String Windows("ExcelBook.xls").Activate Sheets("sheet1").Select inputStr = "58" getCell = Columns("C").Find(inputStr) ------------------------------------------- C列にある文字列を検索して、該当するセルの行番号を取得したいのですが、その検索する「文字列」は数字なんです（0～9000までで重複しません）。 上の方法で実行すると、inputStrに代入した数字をgetCellが持ってしまうのですが・・・ 色々考えているのですが分かりません。 どなたか教えて頂けませんか？よろしくお願いします。

  • Excel VBA でテキストボックスの値をセルA列から検索

    いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する