Проблема с VBA Range.PasteSpecial xlPasteValues - PullRequest
Новая
       16

Проблема с VBA Range.PasteSpecial xlPasteValues

0 голосов
/ 29 марта 2020

спасибо за любую поддержку заранее!

У меня проблема с копированием и вставкой данных из файла CSV в таблицу в Excel.

У меня есть макрос, который открывает CSV файл, считывает все идентификаторы в первом столбце и сравнивает его с идентификаторами таблицы в основной рабочей книге. Макрос затем идентифицирует новые идентификаторы и копирует соответствующие данные в основную рабочую книгу, добавляя строки в конец таблицы.

Моя проблема заключается в том, что в файле CSV столбец даты предварительно отформатирован для чтения как 29 / 03/2020 (формат Великобритании), однако, когда данные вставляются в таблицу в основной рабочей книге, даты, где это возможно, вставляются в формат США.

Есть ли способ заставить операцию вставки обработать все данные как текст, который я затем смогу отформатировать? 

Sub LookupIDandPaste(rg As Range, rgCompare As Range, dict As Dictionary, resultType As eResultType, OpenBook As Workbook)
'lookup row number in rgCompare of transaction ID's not already listed in rgBase (identified in sub MainCompare)

    Dim key As Variant
    Dim rowNum As Long
    Dim newRow As Range
    Dim newTableRowNum As Long
    Dim newTableCellRange As Range
    'Dim monzoTransFirstCol As String
    'Set monzoTransFirstCol

        For Each key In dict

        rowNum = Application.Match(key, rgCompare, 0) + 1 'row number in rgCompare of new item (plus 1 to account for header row)
        Set newRow = OpenBook.Sheets(1).Range("A" & rowNum & ":P" & rowNum)

        ThisWorkbook.Sheets("Transactions (Monzo)").ListObjects("MonzoTransactions").ListRows.Add AlwaysInsert:=True

        newTableRowNum = ThisWorkbook.Sheets("Transactions (Monzo)").ListObjects("MonzoTransactions").ListRows.Count + 2
        Set newTableCellRange = ThisWorkbook.Sheets("Transactions (Monzo)").Range("Q" & newTableRowNum) 'cell in table

        newRow.Copy
        newTableCellRange.PasteSpecial xlPasteValues 'paste operation

    Next key

End Sub

1 Ответ

0 голосов
/ 30 марта 2020

Попробуйте, пожалуйста, заменив: 

newRow.Copy
newTableCellRange.PasteSpecial xlPasteValues

на 

With newTableCellRange.Resize(newRow.Rows.Count, newRow.Columns.Count)
      .NumberFormat = "@"
      .value = newRow.value
End With
...