人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelについての質問です。1列目に地点番号、2列目にx座標、3列目にy座標が、数値で入力されているデータがあります。

1,9,3
2,4,7
3,10,8

という感じです。以前、はてなhttp://www.hatena.ne.jp/1085035886にて、各地点を記入した散布図(地点番号のラベルつき)の作成方法を、ご教授いただきました。

今回は、次の段階のご相談なのです。このような地点が、100個ほどあります。一部の地点間は、経路があります。例えば、3番と13番、15番と20番、15番と33番...などが、結ばれています。希望は、前回のラベル付き散布図に加え、この経路を表示させたいのです。例図を作成しました。

http://www.geocities.jp/mugicha1800/sample.jpg

このような表示は、可能でしょうか? 経路がある地点の組み合わせは、ご都合のよい形式で記述できます。Mathematica、もしくはフリーウエア(Win/Linux)でもOKです。

ズバリのご回答には、100ptを差し上げます。できるだけ、ズバリに近いアドバイスが希望です。よろしくお願いいたします。

●質問者: Mugicha2004
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:Excel Linux Mathematica WIN はてな
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● cx20
●50ポイント

http://www.hondarer-soft.com/cx/pukiwiki/pukiwiki.php?Memo%2F200...

[hondarer-soft] to [cx20.main.jp]

URL にソースを貼り付けておきました。

ちょっと手抜き(座標軸の描画などを行っていない)ですが、

経路の作成と地点番号のラベルはできていると思います。

’ オートシェイプを使って線を描画するサンプル

’ <テストデータ>

’ 番号, X軸, Y軸, 経路フラグ(-1の場合、経路なし)

’ 1,9,3,-1

’ 2,4,7,1

’ 3,10,8,-1

’ 4,13,5,1

’ 5,8,15,1

Sub LineDrawTest()

Const nCount = 5 ’ データ件数

Const nScale = 10 ’ 倍率

Dim n ’ データの番号

Dim x_st ’ 線の開始位置(X軸)

Dim y_st ’ 線の開始位置(Y軸)

Dim x_ed ’ 線の終了位置(X軸)

Dim y_ed ’ 線の終了位置(Y軸)

Dim i ’ ループカウンタ

Dim flag ’ 経路フラグ

Dim line

Dim oval

Dim text

For i = 1 To nCount

n = ActiveSheet.Cells(i, 1)

x_ed = ActiveSheet.Cells(i, 2) * nScale

y_ed = ActiveSheet.Cells(i, 3) * nScale

flag = ActiveSheet.Cells(i, 4)

’ flag が -1 の場合、経路が無いものとします。

If i = 1 Or flag = -1 Then

x_st = x_ed

y_st = y_ed

Else

End If

With ActiveSheet

’ 線を表示(X座標、Y座標、X座標2、Y座標2)

Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)

’ 点(○)を表示(X座標、Y座標、幅、高さ)

Set oval = .Shapes.AddShape(msoShapeOval, x_ed - 2, y_ed - 2, 5, 5)

oval.Fill.ForeColor.SchemeColor = 10 ’ 色(赤)を指定

’ 番号を表示(X座標、Y座標、幅、高さ)

Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_ed, y_ed, 15, 15)

text.Select

Selection.Characters.text = CStr(n)

text.Fill.Visible = msoFalse ’ 非表示に

text.line.Visible = msoFalse ’ 非表示に

End With

x_st = x_ed ’ 次回開始位置を指定

y_st = y_ed ’ 次回開始位置を指定

Next

End Sub

◎質問者からの返答

cx20さま、いつも大変お世話になります。今回もわざわざ、長いソースをお書きいただき、恐縮です。動作を確認してみますね。

訂正版のあるとのことですので、次のご回答も拝見しようと思います。


2 ● aki73ix
●100ポイント

http://nifberry.727.net/test/hatena20.xls

VBAで可能です

簡略化していますが

最初にプロットしながら配列に代入

次にリンクをAddLineで結ぶということで可能です。いかがでしょうか?

Private Sub CommandButton2_Click()

TMP = 0

Do While TMP = 0

JP = I

I = I + 1

If Cells(I, 2) = ”” Then TMP = 1

Loop

SX = Cells(1, 7).Value

SY = Cells(2, 7).Value

MAXX = Cells(3, 7).Value

MAXY = Cells(4, 7).Value

BAI = Cells(5, 7).Value

Dim AX(999) As Long

Dim AY(999) As Long

’プロット

For I = 2 To JP

AX(I - 1) = Cells(I, 2).Value

AY(I - 1) = Cells(I, 3).Value

ActiveSheet.Shapes.AddShape(msoShapeOval, SX + AX(I - 1) * BAI, SY + (MAXY - AY(I - 1)) * BAI, 5, 5). _

Select

’赤色

Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10

Selection.ShapeRange.Fill.Visible = msoTrue

Selection.ShapeRange.Fill.Solid

Selection.ShapeRange.Line.ForeColor.SchemeColor = 10

ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, SX + AX(I - 1) * BAI + 10, SY + (MAXY - AY(I - 1)) * BAI, 100, 32).Select

’Selection.ShapeRange.TextFrame.AutoSize = msoTrue

Selection.Characters.Text = Cells(I, 1).Value

Next I

’Link 描画

EN = 3

For I = 2 To JP

PP = Cells(I, 4).Value

If PP <> ”” Then

ActiveSheet.Shapes.AddLine(SX + AX(I - 1) * BAI + EN, SY + (MAXY - AY(I - 1)) * BAI + EN, SX + AX(PP) * BAI + EN, SY + (MAXY - AY(PP)) * BAI + EN).Select

Selection.ShapeRange.Line.ForeColor.SchemeColor = 6

’ピンク

End If

Next I

End Sub

◎質問者からの返答

長文のソースを作成いただき、ありがとうございます。

実は、Excelのマクロに不慣れのため、どのように動作させればよいのか、試行錯誤している状態です。まだ、動いていません。

お書きいただいたURLも、サーバがダウンしているようで、サンプルファイルの取得ができておりません。

現在、マクロ自体を勉強しています。希望とおりの内容であれば、100pt差し上げますね。


3 ● un-G
●0ポイント

http://www.hatena.ne.jp/1087797083

Excelについての質問です。1列目に地点番号、2列目にx座標、3列目にy座標が、数値で入力されているデータがあります。 1,9,3 2,4,7 3,10,8 という感じです。以.. - 人力検索はてな

Excelでの例です。

A列:地点名,B:x座標,C:y座標でデータを打ち込みます。

全データを使用してx-y散布図を作成します。

上からデータをa01,a02・・a99とした場合,

a01〜a10,a11〜a20をそれぞれ結んで線を引くとすると,a10とa11の間,a20とa21の間に空白行を挿入すると,線は切れます。

a21〜a99の間に全て空白行を挿入すると,マーカーのみの地点表示となります。

これでは,だめなのでしょうか?

アップしようとしたのですが,ジオが受け付けてくれないのですみません。

◎質問者からの返答

ご回答、ありがとうございます。せっかくのアドバイスですが、散布図において、点間を線で結ぶ方法を知りません。

ちょっと希望条件と違う気がしますが、簡単で良さげな方法のような気がしています。


4 ● cx20
●100ポイント

http://www.hondarer-soft.com/cx/pukiwiki/pukiwiki.php?Memo%2F200...

[hondarer-soft] to [cx20.main.jp]

URL に新しいソースを貼っておきました。

1回目の投稿で、経路の求め方を勘違いしていました。

今回のバージョンは座標軸の描画をサポートしました。

’ オートシェイプを使って線を描画するサンプル(その2)

’ <説明>

’ 経路は4〜5列目に開始〜終了の番号を指定することとします。

’ プログラムは Main() を実行すると動作します。

’ <項目の説明>

’ 1列目:番号

’ 2列目:X座標

’ 3列目:Y座標

’ 4列目:経路の開始番号

’ 5列目:経路の終了番号

’ <テストデータ>

’ 0, 5, 49, 0, 3

’ 1, 2, 5, 0, 4

’ 2, 12, 8, 1, 2

’ 3, 45, 45, 2, 4

’ 4, 4, 21, 2, 9

’ 5, 32, 13, 9, 13

’ 6, 34, 30, 11, 13

’ 7, 30, 31, 1, 7

’ 8, 33, 24, 5, 7

’ 9, 22, 10, 5, 12

’ 10, 20, 5

’ 11, 8, 40

’ 12, 11, 21

’ 13, 37, 43

Option Explicit

Const g_nCount = 14 ’ データ件数

Const g_nScale = 5 ’ 倍率

Const g_nPair = 10 ’ 経路数

Const g_nX_Origin = 10 ’ X軸の原点の位置

Const g_nY_Origin = 10 ’ Y軸の原点の位置

Const g_nX_Step = 10 ’ 方眼用紙のマス目の単位(X軸)

Const g_nY_Step = 10 ’ 方眼用紙のマス目の単位(Y軸)

Const g_nX_MAX = 100 ’ 方眼用紙のサイズ(X軸の最大値)

Const g_nY_MAX = 100 ’ 方眼用紙のサイズ(Y軸の最大値)

’ メイン

Sub Main()

DrawGrid ’ 方眼用紙の作成

DrawDot ’ 点の描画

DrawLine ’ 経路の描画

End Sub

’ 方眼用紙の作成

Sub DrawGrid()

Dim x

Dim y

Dim x_st ’ 線の開始位置(X軸)

Dim y_st ’ 線の開始位置(Y軸)

Dim x_ed ’ 線の終了位置(X軸)

Dim y_ed ’ 線の終了位置(Y軸)

Dim line ’ オートシェイプ:線

Dim text ’ オートシェイプ:テキストボックス

’ 方眼用紙の背景の描画

x = g_nX_Origin * g_nScale

y = 0

ActiveSheet.Shapes.AddShape msoShapeRectangle, x, y, g_nX_MAX * g_nScale, g_nY_MAX * g_nScale

For x = 0 To g_nX_MAX Step g_nX_Step

With ActiveSheet

x_st = (x + g_nX_Origin) * g_nScale

y_st = (g_nY_MAX) * g_nScale

x_ed = (x_st)

y_ed = (0)

’ 線を表示(X座標、Y座標、X座標2、Y座標2)

Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)

’ 番号を表示(X座標、Y座標、幅、高さ)

Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 15, y_st + 10, 30, 15)

text.Select

Selection.Characters.text = CStr(x)

Selection.HorizontalAlignment = xlCenter ’ 中央揃え

text.Fill.Visible = msoFalse ’ 非表示に

text.line.Visible = msoFalse ’ 非表示に

End With

Next

For y = 0 To g_nY_MAX Step g_nY_Step

With ActiveSheet

x_st = (g_nX_Origin) * g_nScale

y_st = (g_nY_MAX - y) * g_nScale

x_ed = (g_nX_Origin + g_nX_MAX) * g_nScale

y_ed = y_st

’ 線を表示(X座標、Y座標、X座標2、Y座標2)

Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)

’ 番号を表示(X座標、Y座標、幅、高さ)

Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 35, y_st - 5, 30, 15)

text.Select

Selection.Characters.text = CStr(y)

Selection.HorizontalAlignment = xlRight ’ 右寄せ

text.Fill.Visible = msoFalse ’ 非表示に

text.line.Visible = msoFalse ’ 非表示に

End With

Next

End Sub

’ 点の描画

Sub DrawDot()

Dim n ’ データの番号

Dim x ’ 線の開始位置(X軸)

Dim y ’ 線の開始位置(Y軸)

Dim i ’ ループカウンタ

Dim oval ’ オートシェイプ:円

Dim text ’ オートシェイプ:テキストボックス

For i = 1 To g_nCount

n = ActiveSheet.Cells(i, 1)

x = (g_nX_Origin + ActiveSheet.Cells(i, 2)) * g_nScale

y = (g_nY_MAX - ActiveSheet.Cells(i, 3)) * g_nScale

With ActiveSheet

’ 点(○)を表示(X座標、Y座標、幅、高さ)

Set oval = .Shapes.AddShape(msoShapeOval, x - 2, y - 2, 5, 5)

oval.Fill.ForeColor.SchemeColor = 10 ’ 色(赤)を指定

’ 番号を表示(X座標、Y座標、幅、高さ)

Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x + 10, y - 5, 20, 15)

text.Select

Selection.Characters.text = CStr(n)

text.Fill.Visible = msoFalse ’ 非表示に

text.line.Visible = msoFalse ’ 非表示に

End With

Next

End Sub

’ 経路の描画

Sub DrawLine()

Dim n ’ データの番号

Dim x_st ’ 線の開始位置(X軸)

Dim y_st ’ 線の開始位置(Y軸)

Dim x_ed ’ 線の終了位置(X軸)

Dim y_ed ’ 線の終了位置(Y軸)

Dim i ’ ループカウンタ

Dim line ’ オートシェイプ:線

For i = 1 To g_nPair

GetXY ActiveSheet.Cells(i, 4), x_st, y_st

GetXY ActiveSheet.Cells(i, 5), x_ed, y_ed

x_st = (g_nX_Origin + x_st) * g_nScale

y_st = (g_nY_MAX - y_st) * g_nScale

x_ed = (g_nX_Origin + x_ed) * g_nScale

y_ed = (g_nY_MAX - y_ed) * g_nScale

With ActiveSheet

’ 線を表示(X座標、Y座標、X座標2、Y座標2)

Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)

End With

Next

End Sub

’ 番号→座標の取得

Function GetXY(ByVal nPos, ByRef x, ByRef y)

Dim n

Dim i

x = 0

y = 0

For i = 1 To g_nCount

’ 1列目の番号を順次取得

n = ActiveSheet.Cells(i, 1)

’ 同じ番号があれば、座標データを取得

If n = nPos Then

x = ActiveSheet.Cells(i, 2)

y = ActiveSheet.Cells(i, 3)

Exit Function

End If

Next

Exit Function

End Function

◎質問者からの返答

cx20さま、たびたびのご回答、ありがとうございます。試用してみました。まさに、希望とおりの動作をしてくれました! とてもうれしいです。

さきほどのご回答とあわせて、150pt、お送りさせていただきますね。これで、実験が進められそうです。大変、助かりました。

aki73ixさまも、わざわざマクロファイルをアップロードしていただきまして、ありがとうございます。こちらも確認させていただきました。ボタン付で使いやすそうですね。ほぼ、希望とおりの図画プロットできました。感謝いたします。お約束とおり、100pt、送信させていただきます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ