Значение терминала от a до C с использованием VBA Loop - PullRequest
0 голосов
/ 14 февраля 2020

У меня имя листа Excel как Terminal Volumes На этом листе есть три переменные (Terminal LF (log Fisher Cost) и CT Cost), которые используются в качестве входных данных. Я использую следующий код для работы над этим.

enter code here
Sub InitiateValues()
ReDim TrmPnts(11) '<<<<CHANGE HERE Total Point + SE -JJ
Set ShDat = Worksheets("Data")
Set ShDatPth = Worksheets("DataPath")
Set tvol = Worksheets("Terminal Volumes")
'ShDatPth.Range("B2:FB157").Value = 0
With TrmPnts(1)
    .Cpt = "T1"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(2, 1)
    .Col = ShDat.Cells(3, 1)
    .LFamt = tvol.Cells(2, 2)
    .CTamt = tvol.Cells(2, 3)
End With
With TrmPnts(3)
    .Cpt = "T2"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(6, 1)
    .Col = ShDat.Cells(7, 1)
    .LFamt = tvol.Cells(3, 2)
    .CTamt = tvol.Cells(3, 3)
End With
With TrmPnts(4)
    .Cpt = "T3"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(8, 1)
    .Col = ShDat.Cells(9, 1)
    .LFamt = tvol.Cells(4, 2)
    .CTamt = tvol.Cells(4, 3)
End With
With TrmPnts(5)
    .Cpt = "T4"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(10, 1)
    .Col = ShDat.Cells(11, 1)
    .LFamt = tvol.Cells(5, 2)
    .CTamt = tvol.Cells(5, 3)
End With
With TrmPnts(6)
    .Cpt = "T5"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(12, 1)
    .Col = ShDat.Cells(13, 1)
    .LFamt = tvol.Cells(6, 2)
    .CTamt = tvol.Cells(6, 3)
End With
With TrmPnts(7)
    .Cpt = "T6"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(14, 1)
    .Col = ShDat.Cells(15, 1)
    .LFamt = tvol.Cells(7, 2)
    .CTamt = tvol.Cells(7, 3)
End With
With TrmPnts(8)
    .Cpt = "T7"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(16, 1)
    .Col = ShDat.Cells(17, 1)
    .LFamt = tvol.Cells(8, 2)
    .CTamt = tvol.Cells(8, 3)
End With
With TrmPnts(9)
    .Cpt = "T8"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(18, 1)
    .Col = ShDat.Cells(19, 1)
    .LFamt = tvol.Cells(9, 2)
    .CTamt = tvol.Cells(9, 3)
End With
With TrmPnts(10)
    .Cpt = "T9"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(20, 1)
    .Col = ShDat.Cells(21, 1)
    .LFamt = tvol.Cells(10, 2)
    .CTamt = tvol.Cells(10, 3)
End With
With TrmPnts(11)
    .Cpt = "T10"
    .CptColr = "&H000088"
    .Row = ShDat.Cells(22, 1)
    .Col = ShDat.Cells(23, 1)
    .LFamt = tvol.Cells(11, 2)
    .CTamt = tvol.Cells(11, 3)
End With '<<<<<<CHANGE HERE
With TrmPnts(2)
    .Cpt = "SE"
    .CptColr = "&H004400"
    .Row = ShDat.Cells(4, 1)
    .Col = ShDat.Cells(5, 1)
End With
ReDim Mtx(156, 157) ' Cell Size X,Y -JJ
For i = 1 To 156 ' Cell Size X,Y -JJ 1 To 226
    For j = 1 To 157 ' Cell Size X,Y -JJ
        Mtx(i, j) = ShDat.Cells(1 + i, 1 + j)
        ShDatPth.Cells(1 + i, 1 + j) = 0
    Next
Next
EdtMod = True
End Sub

Этот код прекрасно работает для ввода значения в T10 (только для 10 строк). Я хочу использовать его для T1500 (1500 строк) для столбца от A до столбца C - используя l oop.

Структура рабочего листа указана ниже.

enter image description here

1 Ответ

0 голосов
/ 14 февраля 2020

Просто сделайте For...next l oop и используйте переменную l oop, чтобы вычислить правильные поля, как показано ниже (надеюсь, я правильно интерпретировал логи c, пожалуйста, проверьте):

Sub InitiateValues()
ReDim trmpnts(11) '<<<<CHANGE HERE Total Point + SE -JJ
Set ShDat = Worksheets("Data")
Set ShDatPth = Worksheets("DataPath")
Set tvol = Worksheets("Terminal Volumes")
'ShDatPth.Range("B2:FB157").Value = 0
Dim I As Long
For I = 1 To UBound(trmpnts)
    With trmpnts(I)
        .Cpt = "T" & I
        .CptColr = "&H000088"
        .Row = ShDat.Cells(I * 2, 1)
        .Col = ShDat.Cells(I * 2 + 1, 1)
        .LFamt = tvol.Cells(I, 2)
        .CTamt = tvol.Cells(I, 3)
    End With
Next I
....
End Sub

Это должно сработать ...

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...