Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9181 / 76732 ←次へ | 前へ→

【73116】Re:どのように考え方を整理すれば良いでしょうか。
発言  kanabun  - 12/11/15(木) 23:00 -

引用なし
パスワード
   ▼うしろ さん:

(改訂版)です
延長と面積のうち、面積のほうは上流の面積をすべて加えたものと
するようにしました。
(Sub TopoMain に差し替えてください)

Sub TopoMain2()
  Dim i&, j&, v
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  Dim upper As Object
  Set upper = CreateObject("Scripting.Dictionary")
  
  
  '// データを読む 2行目から
  v = Range("A2").Resize(N, 4).Value
  For i = 1 To N
    Rname(i) = v(i, 1)
    dic(Rname(i)) = i
  Next
  For i = 1 To N
    If Not IsEmpty(v(i, 2)) Then
      j = dic(v(i, 2))
      mat(i, j) = JUST
    End If
  Next
  
  '// ソーティング実行
  For i = 1 To N
    If Visited(i) = NEVER Then visit i
  Next
  '  計算順の表示
  Dim s As String
  ReDim ans(N, 1 To 3)
  ans(0, 1) = "路線名"
  ans(0, 2) = "総延長"
  ans(0, 3) = "面積"
  For i = 1 To N
    s = Oname(i)
    j = dic(s)
    If upper.Exists(v(j, 2)) Then
      upper(v(j, 2)) = upper(v(j, 2)) & "," & Rname(j)
    Else
      upper(v(j, 2)) = Rname(j)
    End If
    Debug.Print Oname(i); "("; upper(Oname(i)); ") ";
    ans(i, 1) = s
    ans(i, 2) = v(j, 3)
    ans(i, 3) = v(j, 4)
  Next
  Debug.Print
  
  '// 上流から計算
  Dim z As String, e
  Dim which As Long
  Dim tot&
  
  For i = 1 To N
    dic(Oname(i)) = i  '路線名番号を計算順に変更
  Next
  For i = 1 To N
    s = Oname(i)
    '上流を加算
    z = upper(s)
    If Len(z) Then     '上流があるとき
      tot = 0
      For Each e In Split(z, ",")
        j = dic(e)
        If tot < ans(j, 2) Then
          tot = ans(j, 2)
          which = j    '総延長の長いほう
        End If
        ans(i, 3) = ans(i, 3) + ans(j, 3) 'すべての上流面積合算
      Next
      ans(i, 2) = ans(i, 2) + ans(which, 2) '上流延長と合算
     End If
  Next
  Range("F1").Resize(N + 1, 3).Value = ans
  
End Sub
0 hits

【73109】どのように考え方を整理すれば良いでしょうか。 うしろ 12/11/14(水) 21:50 質問
【73111】Re:どのように考え方を整理すれば良いでし... kanabun 12/11/15(木) 12:57 発言
【73118】Re:どのように考え方を整理すれば良いでし... うしろ 12/11/16(金) 21:05 お礼
【73114】Re:どのように考え方を整理すれば良いでし... kanabun 12/11/15(木) 21:10 発言
【73119】Re:どのように考え方を整理すれば良いでし... うしろ 12/11/16(金) 21:12 お礼
【73120】Re:どのように考え方を整理すれば良いでし... kanabun 12/11/17(土) 9:37 発言
【73126】Re:どのように考え方を整理すれば良いでし... うしろ 12/11/17(土) 23:33 お礼
【73116】Re:どのように考え方を整理すれば良いでし... kanabun 12/11/15(木) 23:00 発言
【73127】Re:どのように考え方を整理すれば良いでし... うしろ 12/11/18(日) 5:58 お礼

9181 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free