Excel VBA質問箱 IV

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

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


24712 / 76738 ←次へ | 前へ→

【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

0 hits

【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 発言

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