Перебирать весь файл Excel - PullRequest
0 голосов
/ 02 мая 2018

Я хочу перебрать весь файл Excel.

Sub Rechteck1_KlickenSieAuf()

Dim Zieldatei As String
Dim Line As Integer

'activate and protetct file
    ThisWorkbook.Worksheets(1).Activate
    ActiveWorkbook.Protect

    'Create desired file
    Zieldatei = Application.GetSaveAsFilename(FileFilter:="AVL (*.rtf), *.rtf", InitialFileName:="AVL.rtf")

    'Open desired file
    Open Zieldatei For Output As #1

     With ThisWorkbook.Worksheets(1)

      For Line = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row



           'Write Read-In Data into target data
            Print #1, Join(Application.Transpose(Application.Transpose(.Range(.Cells(Line, 1), .Cells(Line, .Columns.Count).End(xlToLeft)).Value)), "|")


        Next
         End With

    Close #1

    Exit Sub

Этот код выдает сообщение: «несовместимые типы». Я не знаю почему. Буду признателен за любую помощь.

1 Ответ

0 голосов
/ 02 мая 2018

Попробуйте следующее, я считаю, что это должно работать, нет необходимости активировать рабочий лист перед его защитой, поэтому я удалил эту строку, изменил объявление с Integer на Long и в конце изменил Exit Sub на End Sub:

Sub Rechteck1_KlickenSieAuf()
Dim Zieldatei As String
Dim Line As Long
'protect file
ThisWorkbook.Worksheets(1).Protect

'Create desired file
Zieldatei = Application.GetSaveAsFilename(FileFilter:="AVL (*.rtf), *.rtf", InitialFileName:="AVL.rtf")

'Open desired file
Open Zieldatei For Output As #1

    With ThisWorkbook.Worksheets(1)
        For Line = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            'Write Read-In Data into target data
            Print #1, Join(Application.Transpose(Application.Transpose(.Range(.Cells(Line, 1), .Cells(Line, .Columns.Count).End(xlToLeft)).Value)), "|")
        Next
    End With

Close #1

End Sub

UPDATE:

Вместо использования «Возобновить с ошибкой» Далее вы можете проверить, сколько столбцов в данной строке, и проверить, есть ли только один столбец, если в нем есть какие-либо данные, прежде чем перейти к следующей строке, как показано ниже:

Sub Rechteck1_KlickenSieAuf()
Dim Zieldatei As String
Dim Line As Long
Dim LineData As String
'protect file
ThisWorkbook.Worksheets(1).Protect

'Create desired file
Zieldatei = Application.GetSaveAsFilename(FileFilter:="AVL (*.rtf), *.rtf", InitialFileName:="AVL.rtf")

'Open desired file
Open Zieldatei For Output As #1

    With ThisWorkbook.Worksheets(1)
        For Line = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            'Write Read-In Data into target data
            LastCol = .Cells(Line, .Columns.Count).End(xlToLeft).Column
            If Not LastCol = 1 And Not .Cells(Line, 1).Value = "" Then
                LineData = Join(Application.Transpose(Application.Transpose(.Range(.Cells(Line, 1), .Cells(Line, .Columns.Count).End(xlToLeft)).Value)), "|")
                Print #1, LineData
            End If

        Next
    End With

Close #1

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