【会員アンケートご協力のお願い】抽選で計5名様に役立つ書籍をプレゼント!

Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
出力がうまくいかない
投稿日時: 24/09/04 22:03:09
投稿者: yama1006
メールを送信

やりたいこと
 
ary1(i,64)の配列に格納したデータをBL列(64列目)10行から出力したいです。
 
A10から最終行までの番号に紐づいたデータをary1(i,64)に格納しております。
 
なので、番号それぞれに紐づいたデータがBL列の10行目から最終行まで出力してほしいです。
 
 
Option Explicit
 
Sub 月変確認用()
 
Dim 月変予定確認表 As Worksheet
 
Dim 通勤4月前 As Worksheet
 
Dim 通勤3月前 As Worksheet
 
Dim 通勤手当マスタ As Worksheet
 
Dim 社労夢 As Worksheet
 
Dim 変動合計 As Worksheet
 
Dim ws1 As Worksheet
 
Set ws1 = ThisWorkbook.Sheets("月変予定者確認表")
 
Dim ary1 As Variant
 
Dim i As Long
 
Dim rng As Range
 
Dim rng2 As Range
 
Dim rng3 As Range
 
Dim rng4 As Range
 
Dim rng5 As Range
 
 
ary1 = Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM")).Value ’ここがだめでしょうか?
 
 
For i = 1 To UBound(ary1, 1) - 1
 
 
   Set rng = ws1.Cells(i + 9, 1)
     
   Dim colB As Long
    
   On Error Resume Next
    
    
   colB = WorksheetFunction.Match(rng, ws1.Columns("A"), 0)
    
   On Error GoTo 0
    
   If Not IsError(colB) Then
    
    
   ary1(i, 7) = ws1.Cells(colB, 7) 'パート区分
    
   ary1(i, 29) = ws1.Cells(colB, 29) '固定的賃金
    
   ary1(i, 33) = ws1.Cells(colB, 33) '車通勤判定
    
   ary1(i, 34) = ws1.Cells(colB, 34) 'ガソリン単価
    
   ary1(i, 36) = ws1.Cells(colB, 36) 'ガソリン単価固定的賃金
    
   ary1(i, 47) = ws1.Cells(colB, 47) '3月前基礎日数
    
   ary1(i, 51) = ws1.Cells(colB, 51) '2月前基礎日数
    
   ary1(i, 55) = ws1.Cells(colB, 55) '1月前基礎日数
    
    ary1(i, 57) = ws1.Cells(colB, 57) '3カ月平均
     
   ary1(i, 62) = ws1.Cells(colB, 62) '等級差
    
 Else
  
   Debug.Print "match not found for value:" & rng.Value
    
 End If
 
Next
 
'対象外 基礎日数不足
 
If ary1(i, 47) < 17 Or ary1(i, 51) < 17 Or ary1(i, 55) < 17 Then
 
    ary1(i, 64) = "基礎日数不足"
     
ElseIf ary1(i, 7) = "対象(短時間)" Then
 
     If ary1(i, 47) < 11 Or ary1(i, 51) < 11 Or ary1(i, 55) < 11 Then
     
     ary1(i, 64) = "短時間基礎日数不足"
   
  End If
   
End If
 
 
'対象外 固定賃金変動なし
 
If ary1(i, 29) = "変動なし" Then
       
  If ary1(i, 36) = "変動なし" Then
   
      ary1(i, 64) = "固定賃金変動なし"
            
         End If
       
    End If
     
  '対象外 上がり一等級差
     
  If ary1(i, 29) = "上がり固定" Then
   
    If ary1(i, 62) < 1 Then
      
     ary1(i, 64) = "1等級差"
      
         End If
     
    End If
     
     
      '対象外 上がり等級マイナス
     
  If ary1(i, 29) = "上がり固定" Then
   
    If ary1(i, 62) < 0 Then
      
     ary1(i, 64) = "固定↑等級↓"
      
         End If
     
    End If
     
     
 If ary1(i, 33) = "車通勤" Then
     
    If ary1(i, 29) = "変動なし" Then
       
      If ary1(i, 36) = "上がり固定" Then
   
         If 0 < ary1(i, 62) < 2 Then
   
      ary1(i, 64) = "ガソリン単価+1等級差"
              
              End If
       
          End If
     
    End If
     
End If
 
 
 If ary1(i, 33) = "車通勤" Then
     
    If ary1(i, 29) = "変動なし" Then
       
      If ary1(i, 36) = "下がり固定" Then
   
         If ary1(i, 62) > -1 Then
   
      ary1(i, 64) = "ガソリン単価+1等級差"
              
              End If
       
          End If
     
    End If
     
End If
 
   
  '上がり月変
   
   If ary1(i, 29) = "上がり固定" Then
   
      If ary1(i, 62) > 1 Then
      
       ary1(i, 64) = "上がり月変"
        
        If rng2 Is Nothing Then
           
            Set rng2 = ws1.Cells(i, 64)
           
            Else
            
            Set rng2 = Union(rng2, ws1.Cells(i, 64))
             
          End If
      
      End If
     
    End If
     
    '単価上がり月変
   
 If ary1(i, 33) = "車通勤" Then
     
    If ary1(i, 29) = "変動なし" Then
       
      If ary1(i, 36) = "上がり固定" Then
   
         If ary1(i, 62) > 1 Then
   
      ary1(i, 64) = "単価+上がり月変"
       
           If rng3 Is Nothing Then
           
            Set rng3 = ws1.Cells(i, 64)
           
            Else
            
            Set rng3 = Union(rng3, ws1.Cells(i, 64))
             
                 End If
           
              End If
       
          End If
     
    End If
     
End If
 
  '下がり月変
   
   If ary1(i, 29) = "下がり固定" Then
   
      If ary1(i, 62) < -1 Then
      
       ary1(i, 64) = "下がり月変"
        
          If rng4 Is Nothing Then
           
            Set rng4 = ws1.Cells(i, 64)
           
            Else
            
            Set rng4 = Union(rng4, ws1.Cells(i, 64))
             
            End If
      
         End If
     
    End If
     
     
  '単価下がり月変
   
 If ary1(i, 33) = "車通勤" Then
     
    If ary1(i, 29) = "変動なし" Then
       
      If ary1(i, 36) = "下がり固定" Then
   
         If ary1(i, 62) < -1 Then
   
      ary1(i, 64) = "単価+下がり月変"
       
           If rng5 Is Nothing Then
           
            Set rng5 = ws1.Cells(i, 64)
           
            Else
            
            Set rng5 = Union(rng5, ws1.Cells(i, 64))
             
                End If
              
              End If
       
          End If
     
    End If
     
End If
 
'書き出し
 
 ws1.Range("BL10").Resize(UBound(ary1, 1), 1).Value = Application.Index(ary1, i, 64) '同じ内容が出力されてしまいます。
 
 
 
End Sub

回答
投稿日時: 24/09/04 22:34:34
投稿者: WinArrow

引用:
ws1.Range("BL10").Resize(UBound(ary1, 1), 1).Value = Application.Index(ary1, i, 64) '同じ内容が出力されてしまいます。

コードの中身はわからないので、見ていませんが、
 
> Application.Index(ary1, i, 64) 
の「i」の値をック人してみてください。
おそらくary1配列の最終行になっているとおもいます。

回答
投稿日時: 24/09/05 06:52:36
投稿者: simple

そもそもそのコードの意味は理解されているのですか?
ary1のi行,64列目の値を、左のセル範囲に書き出せ、という命令ですけど。
 
>ary1(i,64)の配列に格納したデータをBL列(64列目)10行から出力したいです。
ary1(i,64)の配列と言う表現が、なにか曖昧でわからない。
ary1配列という意味じゃなく、別の意味があるんですか?
 
以下のテストコードを別のシートで試して確認してみてはどうですか?

Sub test()
    Dim r&, c&
    Dim v

    Rem 配列vを作成
    For r = 1 To 3
        For c = 1 To 4
            Cells(r, c) = r & "," & c
        Next
    Next
    v = [A1:D3]
    
    'その3行目だけを取り出す
    '縦に並べたいなら
    [F1].Resize(4, 1) = Application.Transpose(Application.Index(v, 3, 0))
    '横に並べるなら
    [H1].Resize(1, 4) = Application.Index(v, 3, 0)
End Sub

回答
投稿日時: 24/09/05 09:56:50
投稿者: Suzu

既に、他の回答者からも指摘にあがっていますが
 

引用:
ws1.Range("BL10").Resize(UBound(ary1, 1), 1).Value = Application.Index(ary1, i, 64)

 
左辺 操作を受けるオブジェクトは、複数のセル
対して、代入する値は 右辺 Application.Index(ary1, i, 64) で、一つの値を指定しています。
複数のセルに対し、一つの値を指定しているので、同じ値が入って当然です。
 
 
 
Simpleさんのコードをお借りして
 
    'その3行目だけを取り出す
    '縦に並べたいなら
    [F1].Resize(4, 1) = Application.Transpose(Application.Index(v, 3, 0))
    '横に並べるなら
    [H1].Resize(1, 4) = Application.Index(v, 3, 0)

    [H2].Resize(1, 4) = Application.Index(v, 3)
    [H3].Resize(1, 4) = Application.Index(v, 3,1)

 
こうすると
Index の動作について確認しやすいかと思います。
 
 
 
もう一点
 
引用:
If ary1(i, 33) = "車通勤" Then
      
    If ary1(i, 29) = "変動なし" Then
        
      If ary1(i, 36) = "上がり固定" Then
    
If 0 < ary1(i, 62) < 2 Then

 
この書き方はダメです。
 
Sub TEST2()
  Dim i As Long
  i = 2

  If 4 < i < 6 Then
    MsgBox "OK"
  End If
End Sub

を実行すると確認できると思います。

回答
投稿日時: 24/09/05 14:37:32
投稿者: simple

単に配列をそのままシートに書き出すのであれば、

ws1.Range("BL10").Resize(UBound(ary1), UBound(ary1, 2)) = ary1
ですね。
ary1 = Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM")).Value
としているので、BL列でよいのか微妙ですけど。

回答
投稿日時: 24/09/05 18:05:21
投稿者: WinArrow

引用:
ary1 = Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM")).Value ’ここがだめでしょうか?

 
Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM"))
のセル範囲が意図した範囲になっているか?確認していましたか?
 
Debug.Print Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM")).Address
で確認できます。
 
>’ここがだめでしょうか?
の答えです。

回答
投稿日時: 24/09/06 07:42:48
投稿者: WinArrow

途中に
>'対象外 基礎日数不足
というコメントがある
  
その下の
>If ary1(i, 47)
の「i」は、ループを抜けた後だから、
UBound(ary1, 1)と同じ値と思いますが、
確認してみましょう。
  
因みに、その上のループ(For 〜Next)の中身は、
必要なことですか?
それと、Nextの場所が意図したものか?
 
 
rng2、rng3、rng4、rng5
に64行目のセルをセットしているが、
どこにも使われていない。
 
 
※インデントをキチンと付けましょう。
※インデントをキチンと付けると
 プログラム構造が見えてきます。(可動性が上がる)
 意味不明なコードが目立つ・・・これもインデントを付けると見えてきます。

回答
投稿日時: 24/09/06 08:12:55
投稿者: WinArrow

引用:
Dim colB As Long
   On Error Resume Next
   colB = WorksheetFunction.Match(rng, ws1.Columns("A"), 0)
   On Error GoTo 0
   If Not IsError(colB) Then

  
実際には、Match関数がエラーになることはないから、
勘違いしていると思うが、アンマッチになったとしても、
エラーにはならない。
つまり、COLBにはエラー番号が返ってこない。
先入観を捨てて、ステップ実行などで確認しましょう。

回答
投稿日時: 24/09/06 10:38:43
投稿者: simple

繰返して恐縮ですが、
ws1.Range("BL10").Resize(UBound(ary1, 1), 1).Value = Application.Index(ary1, i, 64)
はあなたの意図と異なるものであることはわかりました。
 
それで、本来あなたが実行しようとした意図を日本語で説明していただけますか?
それが先決だと思います。
他人があれこれ想像しても詮無いので、ご自身で明確に説明していただけますか?

回答
投稿日時: 24/09/06 14:48:15
投稿者: WinArrow

投稿日時: 24/09/06 07:42:48投稿者: WinArrow
のレスの中に誤りがあったので、訂正します。
(誤)
rng2、rng3、rng4、rng5
に64行目のセルをセットしているが、
どこにも使われていない。
 
(正)
rng2、rng3、rng4、rng5
に64列目のセルをセットしているが、
どこにも使われていない。

回答
投稿日時: 24/09/07 15:36:20
投稿者: WinArrow

最初に戻って申し訳ないが、
コードを読むと、最初の目的とコードにずれがあると思います。
疑問点を1つづつ潰して行く必要を感じます。
 
1番目
文章では、A列〜BL列を、ary1配列の格納と説明しているが、
本当に説明通りになっているか?検証してみてください。
コードの疑問点は

引用:
Intersect(ws1.Range("A10").CurrentRegion, ws1.Columns("A:BM")).Value 

の中のws1.Range("A10").CurrentRegionです。
9行目(A9〜BM9)のどこかのセルにデータが入っていると、
ary1に格納したデータは、説明と違うことになります。
 
説明と一致させるには、↓のコードの方がよいでしょう。
    With ws1
        RxMax = .Range("A" & .Rows.Count).End(xlUp).Row
        ary1 = .Range(.Range("A10"), .Cells(RxMax, "BM")).Value
    End With

 
2番目
For i = 1 To UBound(ary1, 1) - 1
中略
Next
で、ary1配列の中の一部のデータを再格納しています。
 
これは、どのような意図でしょうか?
 
3番目
Next以下のコードを見ると
イメージとして、ループの中であるかのように見受けられます。
 
以上がおおきな疑問です。
まず、再確認してやりたいことを整理してみてください。
 
 
 

トピックに返信