質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.48%

  • VBA

    1868questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1599questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

エクセルのセルに入っている数字とその座標を出力するマクロ(VBA)

解決済

回答 3

投稿

  • 評価
  • クリップ 1
  • VIEW 1,848

_LAGRANGE_

score 36

シート上の指定したセルのアドレスを(1,A)→(1,1),(1,B)→(1,2)...というふうに (列番号,行番号) の形にし、さらにセルに入っている数字をその後に付け足して(列番号、行番号、数字)の形にしてCSVファイルに出力したいです。
※エクセルでは普通は (行番号,列番号) ですが、xy座標なので (列番号,行番号) と考えてください(^_^;)


単数字(たとえば1)を入力してそのxy座標を取り出すようなマクロは

Sub NumberOnes()
Dim buf As String
Dim rng As Range

buf = ""
For Each rng In ActiveSheet.UsedRange
If rng.Value = 1 Then _
buf = buf & """(" & rng.Column & "," & rng.Row & ")"","
Next
buf = Left(buf, Len(buf) - 1)

Open ThisWorkbook.Path & "\data.csv" For Output As #1
Print #1, buf
Close #1
End Sub

なのですが、つまり、これをシート上の1~50の数字に対して同時に実行し、1つのCSVファイルに(列番号、行番号、数字)を出力したいということです。

マクロに詳しい方、よろしくお願いいたします(>_<)


  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • takito

    2015/09/16 14:44

    例となる実際のエクセルシート(入力)とCSVファイルの完成形(出力)を手作りし、それらのイメージを張りつけていただくと、やりたいことの理解が早くよい回答が得られると思いますよ

    キャンセル

回答 3

checkベストアンサー

0

理解が間違っていたらすみませんが、
質問者様のコードでほぼ答えは出ているのではないでしょうか?

数字が1-50と決まっているのであれば

Sub NumberOnes()
Dim buf As String
Dim rng As Range

buf = ""
For Each rng In ActiveSheet.UsedRange
If (0 < rng.Value And rng.Value < 51) Then _
buf = buf & """(" & rng.Column & "," & rng.Row & "," & rng.Value & ")"","
Next
buf = Left(buf, Len(buf) - 1)

Open ThisWorkbook.Path & "\data.csv" For Output As #1
Print #1, buf
Close #1
End Sub

これでどうでしょうか?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

まず値が1のセルのリスト、次に値が2のセルのリスト、次に値が3のセルのリスト、……、最後に値が50のセルのリストという形式のcsvファイルを作るプログラムを求めていらっしゃるのではないでしょうか。
だとすれば、以下のようなプログラムになります。

Sub NumberOnes()
  Dim buf(1 to 50) As String, result as String
  Dim rng As Range
  Dim num as Integer

  'リストを記録する文字列の配列を初期化する
  for num = 1 to 50
    buf(num) = ""
  next num

  'セルの値が1~50の間なら、その値に対応する文字列にセルの列、行、値を追加する。
  For Each rng In ActiveSheet.UsedRange
    num=rng.Value
    If (0 < num And num < 51) Then
      buf(num) = buf(num) & """(" & rng.Column & "," & rng.Row & "," & num & ")"","
    EndIf
  Next

  '値ごとのリストを1つの文字列 result にまとめる
  result=""
  for num=1 to 50
    result = result & buf(num)
  next

  ’最後の","を取り除く
  '  1~50のセルが1つも無かった場合はresultが空文字列となるので、エラーが起きないようにIfで判断
  if result<>"" Then
    result= Left(result, Len(result) - 1)
  EndIf

  Open ThisWorkbook.Path & "\data.csv" For Output As #1
  Print #1, result
  Close #1
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

色々な実装方法があると思いますので、処理対処のセル範囲を一旦配列に読み込んでしまってから一括処理する方式にしてみました。

Sub NumberOnes()

    Dim buf() As String
    Dim uRng As Range, vRng As Variant
    Dim endRow As Long, endCol As Long
    Dim num As Long, val As Long
    Dim i As Long, j As Long
    

    ' num までの整数を探してcsv出力
    num = 50
    ReDim buf(1 To num)
    
    ' "A1"からデータ入力済みの"最終行/列"までの入力データをvRngへ取り込む
    With ActiveSheet
        Set uRng = .UsedRange
        endRow = uRng.Row + uRng.Rows.Count - 1
        endCol = uRng.Column + uRng.Columns.Count - 1
        Set uRng = Nothing
        vRng = .Range(.Cells(1, 1), .Cells(endRow, endCol)).Value
    End With
    
    ' 入力値が整数で1~num の範囲に入っていたらcsv出力する
    ' i:行番号、j:列番号
    For i = 1 To UBound(vRng, 1)
        For j = 1 To UBound(vRng, 2)
        
            ' データが数値の場合のみ対象
            If WorksheetFunction.IsNumber(vRng(i, j)) Then
                val = vRng(i, j)
                
                ' データが整数かつ1以上num以下の場合のみ対象
                If val = Int(val) And 1 <= val And val <= num Then
                    buf(val) = CStr(i) & "," & CStr(j) & "," & CStr(val)
                End If
                
            End If
            
        Next j
    Next i
    
    ' 結果をcsvファイルへ出力
    Open ThisWorkbook.Path & "\data.csv" For Output As #1
    For i = 1 To num
        If buf(i) = "" Then Exit For
        Print #1, buf(i)
    Next i
    Close #1
    
End Sub

文字列や小数などが入力されていた場合は無視し、整数のみを出力します。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.48%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1868questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1599questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。