Mam trudności z znalezieniem tego problemu. Próbuję znaleźć ciąg department i zastąp go innym działem. Są 16-10 arkuszy w każdym skoroszycie wymaga formatowania. Jednym z formatów wymaga przeniesienia / kopiowania first department string (co do niektórych wierszy) i wklejając go, gdzie był last department, ale pierwszy departament w niektórych arkuszu w {{{ X4}} Nie ma dziale powyżej, ale member number. Powodem jest to, że dokonuje tytułu Departamentu.

Obraz na dole powinno dostarczyć więcej informacji. Wprowadź opis obrazu tutaj

To właśnie mam do tej pory, ale nie spełnia. Byłbym wdzięczny na to pomoc. Proszę zadawać pytania i dać sugestie. Dziękuję Ci.

    Sub format()

       Dim ws As Worksheet
       Dim frstDept As Long
       Dim lastDept As Long
       Dim rng As Long
       Dim n As Long
       Dim nlast As Long
       Dim rw As Range
       Dim i As Integer
       Dim iVal As Integer
       iVal = Application.WorksheetFunction.CountIf(Range("A1:A20000"), "Department")
       Debug.Print iVal

        Set rw = ActiveWorkbook.ActiveSheet.UsedRange.Rows
        nlast = rw.Count

        For Each ws In Sheets
            On Error GoTo NextWS
            For i = iVal To 1 Step -1
                With ws
                        frstDept = Range("A:A").Find(What:="Department", LookIn:=xlValues, LookAt:=xlPart).Row
                        lastDept = Range("A:A").Find(What:="Member Number", LookIn:=xlValues, LookAt:=xlPart).Row
                            If .frstDept.Value = .lastDept.Value Then
                            frstDept.Selection.Offset(0, 2).Cut Destination:=Range("lastDept" + 1).Resize(1)
                            End If
                        End If
                    End With
     NextWS:
                Err.Clear

                Next ws

       End Sub
0
MTBthePRO 15 luty 2017, 23:18

2 odpowiedzi

Najlepsza odpowiedź

Wierzę, że poniższy kod będzie działał:

Sub format()
    Dim ws As Worksheet
    Dim r As Long
    Dim lastDept As String
    Dim nextDept As String
    Dim rw As Long

    For Each ws In Worksheets ' Changed from "Sheets" to "Worksheets" to avoid
                              ' problems if any "Charts" exist
        With ws
            rw = .Cells(.Rows.Count, "A").End(xlUp).Row
            'Grab the details of the last "Department" and then clear the cells
            lastDept = RTrim(.Cells(rw, "A") & .Cells(rw, "B") & .Cells(rw, "C"))
            .Range("A" & rw & ":C" & rw).ClearContents

            For r = rw To 2 Step -1
                If Trim(.Cells(r, "A").Value) = "MEMBER NUMBER" Then
                    nextDept = RTrim(.Cells(r - 1, "A") & .Cells(r - 1, "B") & .Cells(r - 1, "C"))
                    .Range("A" & r - 1 & ":C" & r - 1).ClearContents
                    .Cells(r - 1, "A").Value = lastDept
                    lastDept = nextDept
                End If
            Next
        End With
    Next ws
End Sub

Za każdym razem, gdy znajduje się "Numer członkowski" w kolumnie A, chwyta informacje z kolumn A: C rzędu powyżej, a następnie usuwa te komórki i zastępuje kolumnę A za pomocą włączanych wartości z poprzedniego czasu napotkał "numer członkowski ". (Zakładam, że kolumny połączające A: C do jednego sznurka jest dobrą rzeczą. Jeśli nie, mogę go edytować, aby wartości były przechowywane jako osobne struny).


Edytowane do wyszukiwania "działu" (z poleganiem na rzędzie 1 zawsze jest pusty).

Sub format()
    Dim ws As Worksheet
    Dim r As Long
    Dim lastDept As String
    Dim nextDept As String
    Dim rw As Long

    'Initialise "lastDept" to blank so that the first replacement we make
    '(i.e. the one on the last row) is to an empty value        
    lastDept = ""
    'Loop through every worksheet
    'Use "Worksheets" collection rather than "Sheets" collection so that
    'we don't try to do any processing on Charts ("Sheets" contains both
    'Worksheet and Chart objects)
    For Each ws In Worksheets
        'Use a "With" block so that we don't have to constantly write
        '"ws.Cells", "ws.Range", "ws.Rows", etc - we can just use
        '".Cells", ".Range", ".Rows", etc instead
        With ws
            'Find the end of the data by finding the last non-empty cell in column A
            rw = .Cells(.Rows.Count, "A").End(xlUp).Row
            'Loop (backwards) through each row in the worksheet
            For r = rw To 1 Step -1
                'We only need to process something when Column A starts with
                '"Department", or if this is row 1 (which will be empty)
                If Left(.Cells(r, "A").Value, 10) = "Department" Or r = 1 Then
                    'Temporarily store the current values of this row's columns A:C
                    'Join all three cells into one string to make it look "nicer"
                    nextDept = RTrim(.Cells(r, "A").Value & _
                                     .Cells(r, "B").Value & _
                                     .Cells(r, "C").Value)
                    'Clear out what was in A:C
                    .Range("A" & r & ":C" & r).ClearContents
                    'Write the contents of "lastDept" into column A
                    .Cells(r, "A").Value = lastDept
                    'Change "lastDept" to be the value which we stored in our
                    'temporary variable "nextDept" (The temporary variable was
                    'needed because, by the time we get to this line, we have
                    'written over the top of the information in the worksheet
                    'cells.)
                    lastDept = nextDept
                End If
            Next ' end of processing of a row
        End With
    Next ws ' end of processing of a Worksheet
End Sub
2
YowE3K 16 luty 2017, 01:30

Ustawiasz frstdept do rzędu, tak samo z lastdept. Wierzę, że zamierzasz zamiast tego ustawić je do zasięgu. Spróbuj tego:

Sub format()

   Dim ws As Worksheet
   Dim frstDept As Range
   Dim lastDept As Range
   Dim rng As Long
   Dim n As Long
   Dim nlast As Long
   Dim rw As Range
   Dim i As Integer
   Dim iVal As Integer


    Set rw = ActiveWorkbook.ActiveSheet.UsedRange.Rows
    nlast = rw.Count

    For Each ws In Sheets
        ws.Activate

        iVal = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "*Department*") 
        Debug.Print iVal
        On Error GoTo NextWS
        For i = iVal To 1 Step -1 ' You dont have a next statement closing this for loop.
            With ws
                    Set frstDept = Range("A:A").Find(What:="Department", LookIn:=xlValues, LookAt:=xlPart)
                    Set lastDept = Range("A:A").Find(What:="Department", LookIn:=xlValues, LookAt:=xlPart)
                        If .frstDept.Value = .lastDept.Value Then
                            lastDept.Offset(-1, 0).Value = frstDept.Offset(1, 0).Value

                        End If
                    End If
            End With
 NextWS:
            Err.Clear

            Next ' This should close the for loop for your iVal iteration.
        Next ws

   End Sub

Również oba stwierdzenia Znajdź są takie same, a teoretycznie powinna zwrócić ten sam zakres. Nie mogę zrozumieć, dlaczego używasz tego samego oświadczenia Znajdź z Twojego pytania, więc nie mam sugestii, jak go poprawić.

Kod powyżej prawdopodobnie nie rozwiąże problemu, ale powinno cię bliżej. Moim najlepszym zakładem jest to, że Twoja instrukcja błędu została aktywowana za każdym razem, gdy próbowałeś zdobyć dolę z pierwszych i ostatnich zmiennych, a więc nic nie robił.

Mam nadzieję, że to pomoże.

1
Brandon Barney 15 luty 2017, 21:14