Excel VBA質問箱 IV

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

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


4303 / 13646 ツリー ←次へ | 前へ→

【57310】文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/6(水) 11:48 質問[未読]
【57311】Re:文字の色の同期と循環参照について ひげくま 08/8/6(水) 11:57 発言[未読]
【57312】Re:文字の色の同期と循環参照について ハチ 08/8/6(水) 12:35 発言[未読]
【57313】Re:文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/6(水) 15:08 発言[未読]
【57322】Re:文字の色の同期と循環参照について ハチ 08/8/7(木) 18:54 発言[未読]
【57368】Re:文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/14(木) 18:56 発言[未読]
【57370】Re:文字の色の同期と循環参照について neptune 08/8/14(木) 19:27 発言[未読]
【57371】Re:文字の色の同期と循環参照について Yuki 08/8/15(金) 14:31 発言[未読]
【57372】Re:文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/15(金) 22:12 発言[未読]
【57373】Re:文字の色の同期と循環参照について Yuki 08/8/16(土) 10:30 発言[未読]
【57387】Re:文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/16(土) 22:39 発言[未読]
【57427】Re:文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/21(木) 17:44 お礼[未読]
【57314】Re:文字の色の同期と循環参照について SS 08/8/6(水) 18:04 発言[未読]

【57310】文字の色の同期と循環参照について
質問  なんじゃ、こりゃ・・・。  - 08/8/6(水) 11:48 -

引用なし
パスワード
   今回、友人に頼まれ、ソフトの作成を行なっております。
その過程で、どうしてもVBAを使わなければ解決できないのではないだろうか、と思い、このサイトにたどり着きました。
ぜひ、ご教授いただければ、嬉しいです。

複数の質問をしないようにとありましたが、同じソフトの中で生じた問題ですので、一つの質問とさせていただきます。

1行目と1列目に10人の同じリストがあります。
なお、このリストは、行、列共に、並べ替えられる可能性があります。

(1)
この時点で、11行11列の表になりますが、12行目、12列目にそれぞれの行、列の最大値を持つセルと同期したセルを作りたいんです。
最大値だけであれば普通に出来るのですが、文字の色も同期させたいのです。
つまり、
最大値を持つセルの文字の色が赤であれば、12行(列)目も赤に、
最大値を持つセルの文字の色が青であれば、12行(列)目も青にします。

(2)
1つの例として、
("山田花子"、"山田太郎")のセルに何らかの文字列が入力されると
("山田太郎"、"山田花子")のセルに"---"を入れたいんです。
また、この逆の可能性、つまり、("山田太郎"、"山田花子")のセルに何らかの文字列が入力され、("山田花子"、"山田太郎")のセルに"---"を入れる、ということもありえます。
普通に作ろうとすると循環参照になってしまうのです。

では、ご教授ください。
よろしくお願いします。

【57311】Re:文字の色の同期と循環参照について
発言  ひげくま  - 08/8/6(水) 11:57 -

引用なし
パスワード
   こんにちは。
説明が解りにくいですね。
文章だけの説明では限界があります。
具体的に、表を書いて説明してもらえませんか?
その際には、「等幅」にチェックをしてくださいね。

【57312】Re:文字の色の同期と循環参照について
発言  ハチ  - 08/8/6(水) 12:35 -

引用なし
パスワード
   ▼なんじゃ、こりゃ・・・。 さん:

全体のイメージとしては、星取表(対戦表)のような感じですかね?
VBAでやるとしたら、Worksheet_Changeイベントで処理することになると思います。

よくわからないのが・・・
文字列を入力するのに、「最大値」を求める となっている点です。

【57313】Re:文字の色の同期と循環参照について
発言  なんじゃ、こりゃ・・・。  - 08/8/6(水) 15:08 -

引用なし
パスワード
   早速レスいただき、本当にありがとうございます。

説明がうまく出来ず、申し訳ありません。
つまり、このようなことです。四行四列で例をあげます。

   一郎 二郎 三郎 四郎
一郎 ==    8/1     8/1
二郎    ==    −− 空白
三郎 −−    == −− 空白
四郎    7/23 9/4  == 9/4
   空白 7/23 9/4  空白

ちなみに、本人同士は対戦はないので、==を入力しておきます。

セルに入力されるのは、日付なので文字列としました。
最新の日付ほど、最大値という認識でよろしいんですよね?

【57314】Re:文字の色の同期と循環参照について
発言  SS  - 08/8/6(水) 18:04 -

引用なし
パスワード
   こんばんは、ためしにこんなもの作ってみました。
行又は列が全て空欄の時のエラー回避処理はしていません。
中途半端ですが参考になれば幸いです。

Sub test()
  Dim i As Long, j As Long, k As Long
  For i = 1 To 11
    k = i + 1
    Cells(13, k).Value = Application.Max(Range(Cells(2, k), Cells(12, k)))
    j = Application.Match(Cells(13, k).Value, Range(Cells(2, k), Cells(12, k)))
    Cells(13, k).Font.ColorIndex = Cells(1 + j, k).Font.ColorIndex
    
    Cells(k, 13).Value = Application.Max(Range(Cells(k, 2), Cells(k, 12)))
    j = Application.Match(Cells(k, 13).Value, Range(Cells(k, 2), Cells(k, 12)))
    Cells(k, 13).Font.ColorIndex = Cells(k, 1 + j).Font.ColorIndex
  Next i
End Sub

【57322】Re:文字の色の同期と循環参照について
発言  ハチ  - 08/8/7(木) 18:54 -

引用なし
パスワード
   ▼なんじゃ、こりゃ・・・。 さん:

>>セルに入力されるのは、日付なので文字列としました。
>>最新の日付ほど、最大値という認識でよろしいんですよね?

日付型の値であれば、その認識で正しいです。

どのあたりまで、VBAで出来そうですか?

【57368】Re:文字の色の同期と循環参照について
発言  なんじゃ、こりゃ・・・。  - 08/8/14(木) 18:56 -

引用なし
パスワード
   返信が遅くなりました。
SSさんが書いてくださったコードやネットを調べて、出来る所までやってみようと思ったのですが、なにせ初めてVBAを組んでみようと思っているため、なかなか厳しい状況です。とりあえず色は考えずに、最大値を同期させるところまでやってみようと思っているのですが、まだ出来ません・・・。

※C言語を勉強していますので、プログラムの概念はある程度持っています。

【57370】Re:文字の色の同期と循環参照について
発言  neptune  - 08/8/14(木) 19:27 -

引用なし
パスワード
   ▼なんじゃ、こりゃ・・・。 さん:
こんにちは
横から失礼。

>※C言語を勉強していますので、プログラムの概念はある程度持っています。
なら、C言語のつもりでアルゴリズムを書き、判らない点をアルゴリズムを
示して、質問した方がより良いアドバイス、ラッキーならソースをいただけますよ。

そうすれば、言葉の羅列だけではなく、考え方を示す事になりますから。
小さなプログラムですから細かく書いても多寡が知れているんじゃないでしょうか?

CもVBAもプログラミング言語ですから、手法は言語特有の手法にはなりますが、
アルゴリズムにそんなに変わりがあるわけではありません。それを特有の
手法で書くだけです。・・・という私のCは入門+αレベルですが。^ ^;

【57371】Re:文字の色の同期と循環参照について
発言  Yuki  - 08/8/15(金) 14:31 -

引用なし
パスワード
   ▼なんじゃ、こりゃ・・・。 さん:
こんにちは。

単純にループさせてます。
CもVBAも考え方は同じです。

標準モジュールにコーディング

入力後のチェック
最大値を文字色をセット
Sub TEST()
  Dim i  As Long
  Dim j  As Long
  Dim Ci1 As Long
  Dim Ci2 As Long
  Dim dt1 As Date
  Dim dt2 As Date
  Dim eR As Long
  
  With Worksheets(1)
    ' A列の最大行取得
    eR = .Range("A" & .Rows.Count).End(xlUp).Row
    ' 2行目から最大行迄Loop
    For i = 2 To eR
      ' 2列目から最大列迄Loop (行列数は同じ)
      For j = 2 To eR
        ' 行列が同じ番号だったら ===== を代入
        If i = j Then .Cells(i, j).Value = "'====="
        ' セルの内容が日付だったら 列側
        If IsDate(.Cells(i, j).Value) Then
          ' 大きい方の値をセット
          If dt1 < .Cells(i, j).Value Then
            dt1 = .Cells(i, j).Value
            Ci1 = .Cells(i, j).Font.ColorIndex
          End If
        End If
        ' セルの内容が日付だったら 行側
        If IsDate(.Cells(j, i).Value) Then
          If dt2 < .Cells(j, i).Value Then
            dt2 = .Cells(j, i).Value
            Ci2 = .Cells(j, i).Font.ColorIndex
          End If
        End If
      Next
      ' 日付が無かったら
      If dt1 = 0 Then
        ' クリア
        .Cells(i, eR + 1).Value = Empty
      Else
        ' 最大値と文字色をセット
        .Cells(i, eR + 1).Value = dt1
        .Cells(i, eR + 1).Font.ColorIndex = Ci1
      End If
      If dt2 = 0 Then
        .Cells(eR + 1, i).Value = Empty
      Else
        .Cells(eR + 1, i).Value = dt2
        .Cells(eR + 1, i).Font.ColorIndex = Ci2
      End If
      ' 初期化
      dt1 = 0
      dt2 = 0
      Ci1 = 0
      Ci2 = 0
    Next i
  End With
End Sub


対象のシートモジュールに

セル範囲 Range("B2:K11") で日付入力があった対称のセルに ----- を入力
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B2:K11")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If IsDate(Target.Value) Then
    Cells(Target.Column, Target.Row).Value = "-----"
  Else
    '
  End If
End Sub

【57372】Re:文字の色の同期と循環参照について
発言  なんじゃ、こりゃ・・・。  - 08/8/15(金) 22:12 -

引用なし
パスワード
   皆さんのご親切により、徐々にではありますがVBAの流れがつかめてきました。
協力いただいている皆さん、本当に本当にありがとうございます。

Yukiさんが書いてくださったコードについて幾つか質問があります。
Yukiさんが書いてくださったコード部分は「」で記します。
ぜひ、ご教授ください。

(1)
jのFor文が終わった後の
「Next」
は、jが抜けているだけでしょうか。それとも省略できるものなのでしょうか。

(2)
「' A列の最大行取得
eR = .Range("A" & .Rows.Count).End(xlUp).Row」
という命令は、値が連続して入っている範囲を知るものなのでしょうか。
また、行列の数が一緒ではない可能性もあるので、行に対しても同様の処理を行ないたいと考えています。
この場合、命令は
' 1行の最大行取得
eR = .Range("1" & .Rows.Count).End(xlUp).Row
で良いのでしょうか。

(3)
dt1 dt2は最初値が何も入っていないのに、
「If dt1 < .Cells(i, j).Value Then」 や
「If dt2 < .Cells(j, i).Value Then」
という比較が出来るということは、変数は最初に何らかの値に初期化されるという認識でよろしいのでしょうか。

(4)
「' 行列が同じ番号だったら ===== を代入
If i = j Then .Cells(i, j).Value = "'====="」
という部分ですが、行、列共に並べ替えられる可能性があるため、同じ名前が同じ番号に来るわけではないのです。
そこで自分が考えているのは、
まずA2とB1、A2とC1・・・と比較していき、一致する名前があれば、対象セルに'=====を代入
というのをA3、A4・・・eRと繰り返していけば、実現できるのではないかと思います。
このようなことが実現できる命令はありますでしょうか。

(5)
「対象のシートモジュールに」
という部分ですが、ここがよく分かりません。
もう一度例を挙げさせていただきます。

   一郎 三郎 二郎 四郎
四郎

二郎

一郎

三郎

とあり、

   一郎 三郎 二郎 四郎
四郎

二郎

一郎       8/1

三郎
などと入力されたときに、その反対側に---を入力する、つまり

   一郎 三郎 二郎 四郎
四郎

二郎 ---

一郎       8/1

三郎
としたいということなのです。これを実現するプログラムになっているのでしょうか。
自分が考えているのは、これを実現するには、
入力されたセルの行が”一郎”,列が”二郎”であることを知り、
        行が”二郎”、列が”一郎”であるセルに---を入力
という手順なのかなと思っているのですが、このような処理は可能でしょうか。


分からないことだらけで、本当に申し訳ありません。
見当外れのことを質問していましたら、どうぞご了承ください。
また、説明が分かりにくい部分があれば、再度質問させていただきたいと思っています。
よろしくお願い致します。

【57373】Re:文字の色の同期と循環参照について
発言  Yuki  - 08/8/16(土) 10:30 -

引用なし
パスワード
   ▼なんじゃ、こりゃ・・・。 さん:
こんにちは。

>(1)
>jのFor文が終わった後の
>「Next」
>は、jが抜けているだけでしょうか。それとも省略できるものなのでしょうか。
省略できます。For...Next ステートメントのヘルプの最後の方に書いてあります。
>(2)
>「' A列の最大行取得
>eR = .Range("A" & .Rows.Count).End(xlUp).Row」
>という命令は、値が連続して入っている範囲を知るものなのでしょうか。
>また、行列の数が一緒ではない可能性もあるので、行に対しても同様の処理を行ないたいと考えています。
>この場合、命令は
>' 1行の最大行取得
>eR = .Range("1" & .Rows.Count).End(xlUp).Row
>で良いのでしょうか。

eC = .Cells(1, .Columns.Count).End(xlToLeft).Column

>(3)
>dt1 dt2は最初値が何も入っていないのに、
>「If dt1 < .Cells(i, j).Value Then」 や
>「If dt2 < .Cells(j, i).Value Then」
>という比較が出来るということは、変数は最初に何らかの値に初期化されるという認識でよろしいのでしょうか。
Debug.Print dt1 とかを試してみればわかります。

>(4)
>「' 行列が同じ番号だったら ===== を代入
>If i = j Then .Cells(i, j).Value = "'====="」
>という部分ですが、行、列共に並べ替えられる可能性があるため、同じ名前が同じ番号に来るわけではないのです。
>そこで自分が考えているのは、
>まずA2とB1、A2とC1・・・と比較していき、一致する名前があれば、対象セルに'=====を代入
>というのをA3、A4・・・eRと繰り返していけば、実現できるのではないかと思います。
>このようなことが実現できる命令はありますでしょうか。
無いから自分で作ります。
>If i = j Then .Cells(i, j).Value = "'====="

If .Cells(i, 1).Value = .Cells(1, j).Value Then .Cells(i, j).Value = "'====="

>(5)
>「対象のシートモジュールに」
>という部分ですが、ここがよく分かりません。
>もう一度例を挙げさせていただきます。

これは実行すべきシートのモジュールに書くということです。
VBE のプロジェクト エクスプローラの中に
Sheet1(Sheet1)
Sheet2(Sheet2) とかがありますから
対称のシートをWクリックするとそのシートモジュールが開きますよ。

とりあえず行列数バラバラでも動くコードを挙げておきます。
後は御自分で検討して下さい。
分かりやすくする為に速度等は考慮していません。


標準モジュールに

Sub TESTa()
  Dim i  As Long
  Dim j  As Long
  Dim Ci1 As Long
  Dim Ci2 As Long
  Dim dt1 As Date
  Dim dt2 As Date
  Dim eR As Long
  Dim eC As Long
 
  With Worksheets(1)
    ' A列の最大行取得
    eR = .Range("A" & .Rows.Count).End(xlUp).Row
    ' 1行目の最大桁取得
    eC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Rows(eR + 1).ClearContents
    .Columns(eC + 1).ClearContents
    行列数が違うと行側と列側の処理を分けたほうが分かりやすい。
    '最大列+1にデータ
    For i = 2 To eR
      For j = 2 To eC
        ' 行列が同じデータだったら ===== を代入
        If .Cells(i, 1).Value = .Cells(1, j).Value Then .Cells(i, j).Value = "'====="
        If IsDate(.Cells(i, j).Value) Then
          If dt1 < .Cells(i, j).Value Then
            dt1 = .Cells(i, j).Value
            Ci1 = .Cells(i, j).Font.ColorIndex
          End If
        End If
      Next
      If dt1 = 0 Then
        .Cells(i, eC + 1).Value = Empty
      Else
        .Cells(i, eC + 1).Value = dt1
        .Cells(i, eC + 1).Font.ColorIndex = Ci1
      End If
      ' 初期化
      dt1 = 0
      Ci1 = 0
    Next
    '最大行+1にデータ
    For j = 2 To eC
      For i = 2 To eR
        If IsDate(.Cells(i, j).Value) Then
          If dt2 < .Cells(i, j).Value Then
            dt2 = .Cells(i, j).Value
            Ci2 = .Cells(i, j).Font.ColorIndex
          End If
        End If
      Next
      If dt2 = 0 Then
        .Cells(eR + 1, j).Value = Empty
      Else
        .Cells(eR + 1, j).Value = dt2
        .Cells(eR + 1, j).Font.ColorIndex = Ci2
      End If
      ' 初期化
      dt2 = 0
      Ci2 = 0
    Next
  End With
End Sub


シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim eR As Long
  Dim eC As Long
  Dim tC As Long
  Dim tR As Long
  Dim cV As Variant
  Dim rV As Variant
  Dim i  As Long
  
  eR = Range("A" & Rows.Count).End(xlUp).Row
  eC = Cells(1, Columns.Count).End(xlToLeft).Column
  If Intersect(Target, Range(Cells(2, 2), Cells(eR, eC))) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If IsDate(Target.Value) Then
    cV = Cells(1, Target.Column).Value
    rV = Cells(Target.Row, 1).Value
    For i = 1 To eR
      If cV = Cells(i, 1).Value Then
        tR = i
        Exit For
      End If
    Next
    For i = 1 To eC
      If rV = Cells(1, i).Value Then
        tC = i
        Exit For
      End If
    Next
    Cells(tR, tC).Value = "-----"
  End If
End Sub

【57387】Re:文字の色の同期と循環参照について
発言  なんじゃ、こりゃ・・・。  - 08/8/16(土) 22:39 -

引用なし
パスワード
   本当にご丁寧にありがとうございます。
目指していたソフトがほぼ完成しつつあり、皆様の手助けがなければ、
とても実現できなかった事なのですが、なんだかワクワクしています。

Yukiさんが書いてくださったコードをいじり、目的の動作は完了しています。

ただ、標準モジュールに書き込んだプログラムが自動的に実行されないのです。
つまり、日付が入力されたり、日付の色が変えられたときに、最大値を入れるセルも自動的に更新してほしいのですが、Visual Basic Editorの実行ボタン(▲矢印)を押さないと値や色が更新されないのです。
このボタンを押すと、目的の動作が完璧に出来ているので、後一歩といったところなんですが・・・。

ご教授ください。

【57427】Re:文字の色の同期と循環参照について
お礼  なんじゃ、こりゃ・・・。  - 08/8/21(木) 17:44 -

引用なし
パスワード
   標準モジュールに書き込んでいたコードを
シートが変更されたら実行されるように書き換えることで、自己解決しました。

皆様の、ご協力に本当に感謝したいと思います。
全くの初心者に、丁寧に付き合ってくださり、本当にありがとうございました。

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