Question

我有一张像这样的表：

Date        Réf A   Réf B   Client
21/05/18    AA      BB      Alain
22/05/18    CC      DD      Denise
22/05/18    CC      DD      Denise
25/05/18    EE      FF      Fred
25/05/18    EE      FF      Felipe
25/05/18    EE      FF      Fred
26/05/18    GG      HH      Hugo
02/06/18    II      JJ      Jacky

我想构建一个宏，将我导出到一个txt文件（标签分隔符（这很重要）），这个表只在选定的范围内。

例如：

宏（Date1，Date2），带

日期1 = 21/05/2018

日期2 = 25/05/2018

...只向我出口前6行。

我有一段代码可以在定义的范围内构建导出，但我不知道如何调整它：

Sub Export()
    Dim Plage As Object, oL As Object, oC As Object, Sep$, Tmp$
    Dim FileN As String
    FileN = Sheets("Feuil1").Range("Z1")         'Nom du fichier créé
    Sep = vbTab
    With Worksheets(1)
        Set Plage = .Range("A1:D11")
    End With
    FileN = ThisWorkbook.Path & "\test\" & FileN
    Open FileN & ".txt" For Output As #1
    For Each oL In Plage.Rows
        Tmp = ""
        For Each oC In oL.Cells
            Tmp = Tmp & CStr(oC.Text) & Sep
        Next
        Print #1, Tmp
    Next
    Close
End Sub

这里我附上了一个例子：

在左侧：初始表
在中心：Date1和Date2
在右侧：结果

Answer 1

好的，请告诉我这是否适合您。我冒昧地重新格式化了您的初始代码。最大的变化是现在根据Plage上存储的日期值设置Sheets(1)。新函数GetRange尝试将列A中的值与放在开始日期和结束日期单元格中的值进行匹配。

Sub Export()

    Dim FileN As String
    FileN = ThisWorkbook.path & "\test\" & Sheets("Feuil1").Range("Z1").Text     'Nom du fichier créé

    Dim Plage As Range
    Set Plage = getRange

    Dim oL As Range
    Dim oC As Range

    Dim Tmp As String
    Dim Sep As String
    Sep = vbTab

    Open FileN & ".txt" For Output As #1

    For Each oL In Plage.Rows
        Tmp = ""
        For Each oC In oL.Cells
            Tmp = Tmp & CStr(oC.Text) & Sep
        Next
        Print #1, Tmp
    Next

    Close

End Sub

Function GetRange() As Range

    Dim date1 As String
    date1 = Sheets(1).Range("H3").Text

    Dim date2 As String
    date2 = Sheets(1).Range("H4").Text

    Dim i As Integer
    Dim RowStart As Integer
    Dim RowStop As Integer

    With Sheets(1)
        For i = 2 To .Cells(.Rows.count, "A").End(xlUp).Row
            If .Cells(i, "A").Text = date1 Then
                RowStart = i
                Exit For
            End If
        Next i

        For i = 2 To .Cells(.Rows.count, "A").End(xlUp).Row
            If .Cells(i, "A").Text = date2 Then
                RowStop = i
                Exit For
            End If
        Next i

        'depending on your data, maybe make sure RowStop > RowStart
    End With

    Set getRange = Range("A" & RowStart & ":D" & RowStop)

End Function

将所选范围导出为* .txt

1 个答案: