****李宏根兄你在哪里呀***快来救命呀!!

frank0142 2002-11-01 11:51:45
我发现我原来的编的程序只适合,标准的EXCEL的显示,
例如:EXCEL格式是这样的
安徽 合肥
安徽 芜湖
安徽 蚌埠
导入结果正常
如果EXCEL出现合并项时比如一对多的显示的时候,例如:安徽 合肥
芜湖
蚌埠
这种形式的表格时候导入数据库的时候就发现纪录形式是这样的了:
安徽 合肥
芜湖
蚌埠
...全文
60 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
lihonggen0 2002-11-06
  • 打赏
  • 举报
回复
可以先将数据按标准方式导入到EXCEL中,
再用循环读出单元格中数据,判断是否要合并

(程序要用变量记录行数及单元格数据,自己动手写吧)

(比如:设置二个变量beginCell 记录开始合并的单元
EndCell 记录最后合并的单元

取出每一行beginCell=1为:安徽 ,
再取第二行为: 安徽,
循环读第三行时不为安徽则EndCell=2 将一二行合并,
并记录beginCell=3第三行,继续循环....................

程序加上判断beginCell=endCell 则不合并


lihonggen0 2002-11-06
  • 打赏
  • 举报
回复

'才看到,刚改了一下程序,你可以参考这个,来合并单元格


Private Sub Form_Load()
'存字段长度值
'Dim RS As New ADODB.Recordset
' RS.CursorLocation = adUseClient
' RS.Open "select * from Employees", Cn, adOpenStatic, adLockOptimistic

' Dim xlApp As Excel.Application
' Dim xlBook As Excel.Workbook
' Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

' With RS
' If .RecordCount < 1 Then
' MsgBox ("没有记录!")
' Exit Sub
' End If
' xlSheet.Cells(1, 4).Value = .Fields("EmployeeID")
' xlSheet.Cells(2, 1).Value = .Fields("LastName")
' xlSheet.Cells(2, 9).Value = .Fields("FirstName")
' xlSheet.Cells(3, 1).Value = .Fields("Title")
xlSheet.Cells(1, 1).Value = "安徽"
xlSheet.Cells(1, 2).Value = "合肥"
xlSheet.Cells(2, 1).Value = "安徽"
xlSheet.Cells(2, 2).Value = "芜湖"
xlSheet.Cells(3, 1).Value = "安徽"
xlSheet.Cells(3, 2).Value = "蚌埠"
'合并单元格
'Dim nIcol As Integer

xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(3, 1)).Select
With xlApp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With

'网格线
With xlSheet
' .Range(.Cells(1, 1), .Cells(3, 1)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(3, 1)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(3, 1)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With

'显示表格
Dim ExclFileName As String
ExclFileName = App.Path & "\箱单" & ".xls"
If Dir(ExclFileName) <> "" Then
Kill ExclFileName
End If
xlSheet.SaveAs (ExclFileName)
xlApp.Application.Visible = True
'交还控制给Excel
' xlSheet.PrintPreview
' xlApp.Application.Quit
' xlApp.Quit
' End With
End Sub
cgh1970 2002-11-01
  • 打赏
  • 举报
回复
这个不难
cgh1970 2002-11-01
  • 打赏
  • 举报
回复
up

807

社区成员

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧