Excel VBA вставляет фиксированное значение в диапазон - PullRequest
Новая
       5

Excel VBA вставляет фиксированное значение в диапазон

0 голосов
/ 07 сентября 2018

Я пытаюсь скопировать данные вставки из листа "Лист10" в одной книге в файл DataToPaste.csv Лист1. Я успешно копирую остальные данные, однако в столбце K1 мне нужно вставить фиксированное значение из диапазона K1 в количество строк данных в других столбцах. Я получаю значение num строк в DataToPaste.csv в переменной PR, но все еще не могу понять, как мне найти правильный MyPasteRange, скажем, «K1: K4» или около того. Пожалуйста, сообщите! 

       Sub MyMacro()

        Dim LR As Long, PR As Long, X As Long, C As String
        ThisWorkbook.Activate

        With Sheets("Sheet10")
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
        MyCopyRange = Array("A5:A" & LR, "B5:B" & LR, "C5:C" & LR, "D5:D" & LR, "E5:E" & LR, "F5:F" & LR, "G5:G" & LR, "H5:H" & LR, "I5:I" & LR, "J5:J" & LR, "K5:K" & LR, "M5:M" & LR) 'Put ranges in an array
        MyPasteRange = Array("A1", "B1", "C1", "D1", "E1", "F1", "G1", "H1", "I1", "J1", "K1", "L1") '"K1" - Fixed value WILL GO HERE


             'open target csv file
             Set myData = Workbooks.Open(strPath & "DataToPaste.csv")
             Worksheets(1).Select
             Sheets("Sheet1").UsedRange.Clear

            If LR > 1 Then
                j = 0
                For X = LBound(MyCopyRange) To UBound(MyCopyRange) 'Loop the array copying and pasting based on element in the array
               .Range(MyCopyRange(j)).Copy

               If j = 10 Then
                  Dim col As String
                  col = ConvertToLetter(j + 1)
                  PR = Sheets("LOB2RG").Range("A" & .Rows.Count).End(xlUp).Row ' num rows in LOB2RG
                  Dim r As Range
                  Set r = Range(col & "1:" & col & PR)     
                  r.Value  = "ABC"
             Else
                  Sheets("Sheet1").Range(MyPasteRange(j)).PasteSpecial xlPasteValuesAndNumberFormats 'xlPasteValues
             End If

                   j = j + 1
                Next

            Else
                Range("A1") = "No Data Found"
            End If
        End With
    End Sub
Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)

   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

1 Ответ

0 голосов
/ 07 сентября 2018

Вот пример того, как добавить значение во все ячейки в диапазоне от IE K1 до K, в этом примере K14. 

Dim i As Integer
Dim r As Range
i = 10
Set r = Range("K1:K14")
'using PR
'Set r = Range("K1:K" & PR)
'using a dynamic range
'Set r = Range(Cells(1, j), Cells(PR, j))
r.Value = i
...