金蝶星瀚-数据批量导入-如何不区分报表模板批量快速导入多家数据

栏目：云星瀚知识作者：金蝶来源：金蝶云社区发布：2024-09-22浏览：1

1 业务场景

系统上线阶段需要录入大量数据包括去年同期数等，如果让用户一张张表的录入，一般用户不大愿意去做，那么有没有一种方法让用户整理成固定的格式，由顾问批量统一导入呢？今天我们介绍一种快速批量不区分模板和组织的导入方法,将数据整理成下面的格式放到TXT里面就好了。
2 解决方案
我们通过EXCEL模板整理想办法整理成上图的格式，将这个数据粘贴到一个TXT文件中，通过【体系配置】-【应用体系(管理员)】-【多维数据导入与提取】-【导入数据】导入到系统中。

3 关键操作

1.通过EXCEL将用户的报表转换为导入的格式，这方法很多，可以通过拼接公式的方式将输入的报表项目转换成编码后统一放到一个sheet中.
例如：=IF(OR(模板表!K126="",模板表!K126="",ISERROR(VALUE(模板表!K126))=TRUE,模板表!K126=0,),"",模板表!D126&";"&模板表!G126&";"&模板表!$B$1&";"&模板表!E126&";"&模板表!F126&";"&模板表!$C$1&";"&模板表!M126&";"&ABS(模板表!K126)&";")
下面是用户填的表
将数据获取到一个中间过渡表中，本例中为模板表。
将模板表的数据获取到导出表中，本例中"导出期末数"，然后在导出表到TXT.
2.将转换后的格式粘贴到TXT文件中，当然如果你会VB语言，可以通过EXCEL宏直接生成TXT文件，我给大家个例子，大家可以去尝试研究，条条大路通罗马，只要达成我们想要的结果即可。
'初始化
Sub inti()
Application.StatusBar = "正在初始化模板，请稍等……"
'替换公式路径
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Cells.Replace What:="'*HsTbar.xla'!", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
Application.StatusBar = False
End Sub
'生成星瀚合并报表上报文档
Sub f_crtHFMDoc(outsheet, filetype)
'封面参数
pth = ThisWorkbook.Path & "\" '当前路径
lEntity = Sheets("报表封面").[C4].Value '实体
lYear = Sheets("报表封面").[C6].Value '年
lPeriod = Sheets("报表封面").[C7].Value '月
RptType = Sheets("报表封面").[C9].Value '报表类型月报季报
'导出数据工作表
'导出数据去除公式，保留数值
Sheets(outsheet).Cells.Copy
Sheets(outsheet).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
MsgBox "请在星瀚合并报表系统中上载报表数据"
Filename = pth & lEntity & "_" & lYear & "年" & lPeriod & "月_" & RptType & "_" & filetype
If UCase(Right(filetype, 3)) = "TXT" Then
'导出数据另复制存为TXT上报文档
intfile = FreeFile()
Open Filename For Output As #intfile
iLineCount = Sheets(outsheet).UsedRange.Rows.Count
For i = 1 To iLineCount
strtemp = Sheets(outsheet).Cells(i, 1)
Print #intfile, strtemp
Next
Close intfile
Else
'导出数据另存为CSV上报文档
Worksheets(outsheet).Activate
Application.DisplayAlerts = False '不提示用户另存覆盖
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlCSV, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End If
MsgBox Filename
ActiveWorkbook.Close SaveChanges:=False
End Sub
'审核函数
Function f_crtHFMCHK()
Dim chk As String
chk = Sheets("加载数据文件").Range("验证单元格").Value
'chk = 0
If Abs(Int(chk)) = 0 Then '通过审核
f_crtHFMCHK = True
Else
MsgBox "系统审核不通过，请审核通过后重试！"
f_crtHFMCHK = False
End If
End Function
'工作表是否存在
Function IsSheetExist(sName As String)
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets(sName)
If ws Is Nothing Then
IsSheetExist = False
Else
IsSheetExist = True
End If
End Function
'解除工作表保护
Sub unWorksheetProtect()
'ActiveWorkbook.Worksheets("").Unprotect Password:="XXXXXX"
End Sub
'恢复工作表保护
Sub WorksheetProtect()
'ActiveWorkbook.Worksheets("").Protect Password:="XXXXXX", AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub
3. 通过【体系配置】-【应用体系(管理员)】-【多维数据导入与提取】-【导入数据】导入到系统中