Question

我有~100行，有6列。某些行的列A到E相同，F具有唯一值。假设从A2到A7是相同的，但F2到F7具有唯一值。如何将F2到F7放入G2到M2并删除A3到A7行？我使用G2 = IF（A2 = A3，F3，＆＃34;＆＃34;）重复到V17 = IF（A16 = A17，F17，＆＃34;＆＃34;）但我必须消除行和我不知道该怎么做。

对于我正在使用的提取：

Sub extract()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim Found As Boolean

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myitems = GetFolderPatharchive("aaa\bbb").Items
Found = False

    Dim olkMsg As Object, _
        olkFld As Object, _
        excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        intRow As Integer, _
        intCnt As Integer, _
        data_email As String, _
        strFilename As String, _
        arrCells As Variant, _
        varb As Variant, varD As Variant, varF As Variant

        strFilename = "C:\OVERVIEW\EXTRACT"
        If strFilename <> "" Then
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add()
        Set excWks = excWkb.ActiveSheet
        excApp.DisplayAlerts = False
        With excWks
            .Cells(1, 1) = "SENDER"
            .Cells(1, 2) = "SUBJECT"
            .Cells(1, 3) = "CITY"
            .Cells(1, 4) = "DATE"
            .Cells(1, 5) = "HOUR"
            .Cells(1, 6) = "PROBLEM"
        End With
        intRow = 2

        For Each olkMsg In myitems
        If olkMsg.Class = olMail Then

                arrCells = Split(GetCells(olkMsg.HtmlBody), Chr(255))

                For intCnt = LBound(arrCells) To UBound(arrCells) Step 1

 On Error GoTo Handler

    varb = arrCells(intCnt)

    Dim linie As Integer
    linie = InStr(olkMsg.Subject, "-")


                excWks.Cells(intRow, 1) = olkMsg.SenderName
                excWks.Cells(intRow, 2) = Left(olkMsg.Subject, linie - 1) 
                excWks.Cells(intRow, 3) = Left(olkMsg.Subject, 4)
                excWks.Cells(intRow, 4) = Format(olkMsg.ReceivedTime, "dd.mm.yyyy")
                excWks.Cells(intRow, 5) = Format(olkMsg.ReceivedTime, "Hh:Nn:Ss")
                excWks.Cells(intRow, 6) = varb

                intRow = intRow + 1
Next
            End If

Label1:
        Next

        Set olkMsg = Nothing
        excWkb.SaveAs strFilename, 52
        excWkb.Close
    End If

    Set olkFld = Nothing
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing

    MsgBox "Ta dam!", vbInformation + vbOKOnly

Call opexlN
    Exit Sub
Handler:

  If olkMsg <> "Nothing" Then

  MsgBox "..."

  Else: End

End If
Resume Label1:

End Sub

转置列并删除行

0 个答案: