Excel VBA質問箱 IV

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

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


20251 / 76732 ←次へ | 前へ→

【61903】Re:EXCEL VBA 繰返しと計算結果。
お礼  おねがいします。  - 09/6/11(木) 16:20 -

引用なし
パスワード
   Hirofumi さん

こんにちは。

>>  代入のところで値が違います。と出てきます。If Trim(v3(I, 1))
>>  そこで、LastRow3 = .Range & v3 = .Range の前に Ws3.Range としてみたり
>>  ↓不等号を < に変えてみたり色々と試してみたんですが、
>>  ["入力シートに設定できる行がありません。"]または、転記操作の
>>  Sheet3.Range("A" & NewRow) で [NewRow=0] となります。
>
>多分、
>        I = NewRow
>が
>        NewRow = I
>の様な気がします
>
>ついでに、コードをざっと見て行った時に
>元のコードの解釈が違う様な気がしますので
>私成りに書いて見ました
>ただ、サンプルデータが無いので(作るのも面倒なので)Testはして居ません
>間違っていたらゴメン

ありがとうございます。

>
>Option Explicit
>
>Private Sub CommandButton1_Click()
> 
>  Dim i As Long
>  Dim j As Long
>  Dim vntDate As Variant
>  Dim strPrompt As String
>  Dim Ws3 As Worksheet
>  Dim Ws4 As Worksheet
>  Dim lngFound As Long
>  Dim vntList As Variant
>  Dim vntResult As Variant
>  Dim vntFrom As Variant
>  Dim vntTo As Variant
>  Dim lngRows As Long
>  Dim NewRow As Long
>  
>  Set Ws3 = Sheet3
>  Set Ws4 = Sheet4
>  
>  vntDate = Me.TextBox1.Text
>  
>  If vntDate = "" Then
>    strPrompt = "*****日を入力してください。"
>    GoTo Wayout
>  End If
> 
>  '転記先の列番号を列挙
>  vntTo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, _
>          11, 13, 14, 15, 16, 17, 18, 19, 20, 23, 24)
>  '転記元の列番号を列強
>  '"A","C","D","E","F","G","H","I","J","K","AC"
>  ',"X","X","Y","Y","Z","Z","AA","AA","AD","AE"の順で
>  vntFrom = Array(1, 3, 4, 5, 6, 7, 8, 9, 10, _
>          11, 29, 24, 24, 25, 25, 26, 26, 27, 27, 30, 31)
>  
>  'Sheet4のA列最終行を取得
>  If IsEmpty(Ws4.Cells(Rows.Count, 1).Value) Then
>    lngRows = Ws4.Cells(Rows.Count, 1).End(xlUp).Row
>  Else
>    lngRows = Rows.Count
>  End If
>  
>  lngFound = 2
>  NewRow = 3
>  'Sheet4A列でTextBox1と同じ日付の有る行を探索
>  Do While lngFound <= lngRows
>    If Ws4.Cells(lngFound, 1).Value = vntDate Then
>      'Sheet3の空き行位置を取得
>      Do While NewRow <= Rows.Count
>        If Trim(Ws3.Cells(NewRow, 1).Value) = "" Then
>          Exit Do
>        Else
>          NewRow = NewRow + 1
>        End If
>      Loop
>      If NewRow > Rows.Count Then
>        strPrompt = "入力シートに設定できる行がありません。"
>        GoTo Wayout
>      End If
>      '転記先データ行を配列に取得
>      vntResult = Ws3.Cells(NewRow, 1).Resize(, 24).Value
>      '転記元データ行を配列に取得
>      vntList = Ws4.Cells(lngFound, 1).Resize(, 31).Value
>      'データを転記
>      For i = 0 To UBound(vntFrom)
>        vntResult(1, vntTo(i)) = vntList(1, vntFrom(i))
>      Next i
>      vntResult(1, 14) = Sgn(vntResult(1, 14)) * Int(Abs(vntResult(1, 14)) / 21 * 35)
>      vntResult(1, 18) = Sgn(vntResult(1, 18)) * Int(Abs(vntResult(1, 18)) / 4 * 7)
>      For i = 14 To 22 Step 2
>        vntResult(1, 12) = vntResult(1, 12) + vntResult(1, i)
>      Next i
>      '更新データをシートに出力
>      Ws3.Cells(NewRow, 1).Resize(, 24).Value = vntResult
>      '転記元行を削除
>      Ws4.Rows(lngFound).Delete Shift:=xlUp
>      'データ転記 ★上記コードで代用
>'      With Ws4
>'        Ws3.Cells(NewRow, 1).Value = .Range("A" & lngFound).Value
>'        Ws3.Cells(NewRow, 2).Value = .Range("C" & lngFound).Value
>'        Ws3.Cells(NewRow, 3).Value = .Range("D" & lngFound).Value
>'        Ws3.Cells(NewRow, 4).Value = .Range("E" & lngFound).Value
>'        Ws3.Cells(NewRow, 5).Value = .Range("F" & lngFound).Value
>'        Ws3.Cells(NewRow, 6).Value = .Range("G" & lngFound).Value
>'        Ws3.Cells(NewRow, 7).Value = .Range("H" & lngFound).Value
>'        Ws3.Cells(NewRow, 8).Value = .Range("I" & lngFound).Value
>'        Ws3.Cells(NewRow, 9).Value = .Range("J" & lngFound).Value
>'        Ws3.Cells(NewRow, 10).Value = .Range("K" & lngFound).Value
>'        Ws3.Cells(NewRow, 11).Value = .Range("AC" & lngFound).Value
>'        Ws3.Cells(NewRow, 13).Value = .Range("X" & lngFound).Value
>'        Ws3.Cells(NewRow, 14).Value _
>'            = Application.RoundDown(.Range("X" & lngFound).Value / 21 * 35, 0)
>'        Ws3.Cells(NewRow, 15).Value = .Range("Y" & lngFound).Value
>'        Ws3.Cells(NewRow, 16).Value = .Range("Y" & lngFound).Value
>'        Ws3.Cells(NewRow, 17).Value = .Range("Z" & lngFound).Value
>'        Ws3.Cells(NewRow, 18).Value _
>'            = Application.RoundDown(.Range("Z" & lngFound).Value / 4 * 7, 0)
>'        Ws3.Cells(NewRow, 19).Value = .Range("AA" & lngFound).Value
>'        Ws3.Cells(NewRow, 20).Value = .Range("AA" & lngFound).Value
>'        Ws3.Cells(NewRow, 23).Value = .Range("AD" & lngFound).Value
>'        Ws3.Cells(NewRow, 24).Value = .Range("AE" & lngFound).Value
>'        Ws3.Cells(NewRow, 12).Value = Ws3.Cells(NewRow, 14).Value _
>'                      + Ws3.Cells(NewRow, 16).Value _
>'                      + Ws3.Cells(NewRow, 18).Value _
>'                      + Ws3.Cells(NewRow, 20).Value _
>'                      + Ws3.Cells(NewRow, 22).Value
>'        .Rows(lngFound).Delete Shift:=xlUp
>'      End With
>      '行データ削除により最終行を1つ減らす
>      lngRows = lngRows - 1
>      '次の空白行探す為、1行下へ
>      NewRow = NewRow + 1
>    Else
>      lngFound = lngFound + 1
>    End If
>  Loop
>  
>  strPrompt = "日付列行末に達しましたので終了します"
>
>Wayout:
>
>  Set Ws3 = Nothing
>  Set Ws4 = Nothing
>
>  MsgBox strPrompt, vbInformation
>
>End Sub

早速やってみます。ホントにありがとうございます。

0 hits

【61854】EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 14:16 質問
【61860】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/9(火) 16:18 回答
【61862】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 16:45 お礼
【61863】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/9(火) 16:52 発言
【61866】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 17:29 お礼
【61878】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/10(水) 10:37 発言
【61888】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/10(水) 15:55 お礼
【61898】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 11:39 質問
【61899】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 14:08 発言
【61902】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 16:16 お礼
【61904】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 17:35 発言
【61905】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 18:34 お礼
【61912】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 22:18 発言
【61922】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 10:14 お礼
【61924】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/12(金) 10:34 発言
【61901】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/11(木) 15:12 発言
【61903】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 16:20 お礼
【61919】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/12(金) 8:46 発言
【61925】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 10:49 お礼
【61935】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/12(金) 22:21 回答
【61968】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/15(月) 15:03 お礼
【61934】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 17:34 質問
【61936】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/12(金) 23:56 回答
【61938】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/13(土) 8:59 回答
【61963】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/15(月) 10:19 お礼
【61861】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/9(火) 16:30 発言
【61864】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 17:01 お礼

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