数据对应导出

小星光

求助数据对应导出问题

ykcbf1100

你至少说明一下导出的规则吧。是递增呢？还是每次全新导出？还是已有数据就不再导出。

小星光

ykcbf1100 发表于 2023-6-1 06:55
你至少说明一下导出的规则吧。是递增呢？还是每次全新导出？还是已有数据就不再导出。

谢谢老师！是每次全新导出。

3190496160

Sub 导出资料()
Application.ScreenUpdating = False
Dim Fs$, MyP$, Wb As Workbook, k
Dim arr, brr, j, m, y
b = ActiveSheet.[a65536].End(xlUp).Row
y = ActiveSheet.[a65536].End(xlUp).Row
arr = ActiveSheet.Range("a3:e" & b)
MyP = ThisWorkbook.Path & "\"
Fs = Dir(MyP & "粤海" & [C1] & "年汇总表.xls")
If Fs = "" Then MsgBox "找不到" & "粤海" & [C1] & "年汇总单.xls": End
Set Wb = Workbooks.Open(MyP & Fs)
With Wb.Sheets("1月份")
    .UsedRange.Borders.LineStyle = 0
    .UsedRange = Empty
    .Range("a3").Resize(UBound(arr), UBound(arr, 2)) = arr
    .Range("a3").Resize(UBound(arr), UBound(arr, 2)).Borders.LineStyle = 1
End With
Wb.Close savechanges:=True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

数据对应导出.rar (18.41 KB, 下载次数: 8)

2023-6-1 10:34 上传

点击文件名下载附件

小星光

3190496160 发表于 2023-6-1 10:34

老师你好！导出后要行成这样的。

3190496160

Sub 导出资料()
Application.ScreenUpdating = False
Dim Fs$, MyP$, Wb As Workbook, k
Dim arr As Variant
Dim br()
With ActiveSheet
    b = .[a65536].End(xlUp).Row
    arr = .Range("a3:e" & b)
End With
ReDim br(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 1 To UBound(arr)
    n = n + 1
    br(n, 1) = arr(i, 5)
    br(n, 2) = arr(i, 3)
    br(n, 3) = arr(i, 4)
    br(n, 4) = arr(i, 1)
    br(n, 5) = arr(i, 2)
Next i

MyP = ThisWorkbook.Path & "\"
Fs = Dir(MyP & "粤海" & [C1] & "年汇总表.xls")
If Fs = "" Then MsgBox "找不到" & "粤海" & [C1] & "年汇总单.xls": End
Set Wb = Workbooks.Open(MyP & Fs)
With Wb.Sheets("1月份")
    .UsedRange.Borders.LineStyle = 0
    .UsedRange = Empty
    .Range("a3").Resize(n, UBound(br, 2)) = br
    .Range("a3").Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Wb.Close savechanges:=True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

数据对应导出.rar (19.18 KB, 下载次数: 5)

2023-6-1 14:28 上传

点击文件名下载附件

小星光

3190496160 发表于 2023-6-1 14:28

谢谢您大师！非常爽！