Excel VBA Для каждой ячейки в диапазоне, кажется, проходит через одну и ту же ячейку несколько раз - PullRequest
Новая
       43

Excel VBA Для каждой ячейки в диапазоне, кажется, проходит через одну и ту же ячейку несколько раз

0 голосов
/ 22 октября 2018

Кажется, оператор "for-each cell in range" выполняется через одну и ту же ячейку несколько раз.

См. Снимок экрана.

Он проходит через ячейку сСлово «Продукт» четыре раза, потому что оно объединено в четыре строки.

Есть ли способ заставить его запускаться только один раз, независимо от дизайна рабочего листа (другими словами, я предпочитаю не использовать тот факт, что он объединен в четыре строки, которые необходимо учитывать при кодировании).

EXCEL

Public Sub ProcessBeijingFile(Excel_UNC_Path As String)

    Dim src As Workbook

    Dim ProdPushWorkbook As Workbook

    Set ProdPushWorkbook = ActiveWorkbook


    Set src = Workbooks.Open(Excel_UNC_Path, True, True)

    Dim c As Range
    Dim r As Range
    Dim LastRow As Long

    Dim text As String

    src.Sheets("Page 1").Activate

    src.ActiveSheet.Range("A1").Select
    LastRow = src.ActiveSheet.Range("A30000").End(xlUp).Row
    text = LastRow
    text = "A2:BA" + CStr(text)

    Set r = Range(text)

    Dim i As Integer

    For i = 1 To MaxItems
        PONumber(i) = ""
    Next


    Dim PageCounter As Integer
    PageCounter = 0
    RecordCounter = 0

    Dim NextPONumber As String
    NextPONumber = ""


    For Each c In r



        If Left(Trim(c.Value), 5) = "PO No" Then
            NextPONumber = Trim(Replace(c.Value, "PO No.:", ""))
            NextPONumber = Trim(Replace(NextPONumber, "PO No:", ""))
        End If
            ....

Ответы [ 2 ]

0 голосов
/ 23 октября 2018

Дэвид указал мне правильное направление.Вот ключ: 

if c.MergeCells then
      If Trim(GetFirstWord(c.MergeArea.Address, ":")) = c.Address Then
            'the first of merged cells, then process, else don't process...

Необходимая функция: 

Public Function GetFirstWord(ByVal SearchString As String, Optional ByVal Delimeter As String = " ") As String



    If SearchString = "" Then
        GetFirstWord = ""
Else

    Dim ary As Variant
    ary = Split(SearchString, Delimeter)
    GetFirstWord = ary(LBound(ary))
End If


'    GetFirstWord = ary(LBound(ary))
'GetFirstWord = ary(LBound(ary))

Функция завершения

0 голосов
/ 23 октября 2018

Если вы не заботитесь о производительности и просто хотите простой код, ниже показано, как можно пропустить MergedCells.Он отображает адрес и значение непустых ячеек из ячейки B1 в окне Immediate, пока не достигнет пустой ячейки.Вид того, что вам нужно. 

Option Explicit

Sub Sample()
    Dim oRng As Range
    Set oRng = Range("B1")
    Do Until IsEmpty(oRng)
        Debug.Print oRng.Address, oRng.Value
        Set oRng = oRng.Offset(1)
    Loop
    Set oRng = Nothing
End Sub
...