Question

VBA 编程问题，具体要求如下

1 数据特点如下 有50个股票数据 每个股票有600个日期的数据 每个股票的日期数据都是排在一起 且按顺序排在一起的，现在要求将每个股票的数据全部复制出来 形成单独的工作表。假设50个股票 每个100个数据 列数据 是3列 因此有5000行 且每个股票的日期数据都按顺序排在一起，编程将之复制出来。
2 数据在两个EXCEL里面，一个是2010年和之前的数据，一个是2010年之后的数据， 每个EXCEL 里面的股票数量 和标的都是相同的，也就是说每个股票的日期数据被分布在两个EXCEL 里面，现在我想把每个股票从两个excel拿出来，放到一个新表里面

图片5

图片6

图片7
图片5是excel 1 里面的数据 图片6是 EXCEL 2 里面的数据 现在要求将之合并到一个表里面 如图7的样子大神可以加我QQ，然后可以面谈悬赏值 我还有一些问题要请教 可以继续追加悬赏





Answer 1

给你一个例子，这是我为了解决部分问题而编写的，调试已经通过，其中这些文件放在三个文件夹中，取出来统计到一起，你参考下，有不明白的问我。

'本表的算法分析
'将不良品日报表本月的内容和本月维修汇总表格本月的内容加总，同时将不良品汇总表格上月的存量一起累计出本月的存量
'为了程序的编写方便,不考虑不良品汇总表格的上月内容，实际使用时将其直接从上月拷贝过来使用即可
'这个算法是借用了字典新的item增加是往下加的效果，因此不能高错乱了，因为上月存量是与料号是一一对应的
'不统计本月维修的料号种类的原因是因为本月不良日报表和上月存量内的所有料号是涵盖本月维修的料号的
Sub RefreshData()
Dim wb_bl As Workbook '不良品日报表工作簿
Dim wb_wx As Workbook '维修日报表工作簿

Dim sht_me As Worksheet '本报表,即不良品汇总表
Dim sht_wx As Worksheet '维修日报表
Dim sht_bl As Worksheet '不良品日报表
Dim str As String

Set sht_me = ThisWorkbook.ActiveSheet
str = ThisWorkbook.Path

str = Mid(str, 1, InStrRev(str, "\")) '获取上一层目录
Application.ScreenUpdating = False

Set wb_bl = GetObject(str & "不良品日报表" & "\" & Left(ThisWorkbook.Name, 2) & "年不良品统计.xlsm")
Set wb_wx = GetObject(str & "维修日报表" & "\" & Left(ThisWorkbook.Name, 2) & "年维修统计.xlsm")

For Each sht_bl In wb_bl.Sheets '获取不良品日报表月份
If sht_bl.Name = sht_me.Name Then
Exit For
End If
Next

For Each sht_wx In wb_wx.Sheets '获取维修日报表月份
If sht_wx.Name = sht_me.Name Then
Exit For
End If
Next

Set d = CreateObject("scripting.dictionary")

Dim cnt_me As Integer
Dim cnt_bl As Integer
Dim cnt_wx As Integer

Dim arr1, x As Integer
arr1 = sht_me.Range("b3:b" & sht_me.Range("b65536").End(xlUp).Row)
For x = 1 To UBound(arr1) '将本表对应月份的料号导入到字典
d(arr1(x, 1)) = x + 1
Next x

arr1 = sht_bl.Range("b3:b" & sht_bl.Range("b65536").End(xlUp).Row)
For x = 1 To UBound(arr1) '将不良品对应月份的料号导入到字典
d(arr1(x, 1)) = x + 1
Next x

'维修统计表的料号不需要导入的原因是,维修的内容必定是基于上月存量和本月不良
sht_me.Range("B3").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.keys)

cnt_me = sht_me.Cells(65535, 2).End(xlUp).Row
cnt_bl = sht_bl.Cells(65535, 2).End(xlUp).Row
cnt_wx = sht_wx.Cells(65535, 2).End(xlUp).Row
For x = 3 To cnt_me
sht_me.Cells(x, 4).Value = Application.WorksheetFunction.SumIf(sht_bl.Range("b3:b" & cnt_bl), sht_me.Cells(x, 2), sht_bl.Range("d3:d" & cnt_bl)) '不良品数量
sht_me.Cells(x, 5).Value = Application.WorksheetFunction.SumIf(sht_wx.Range("b3:b" & cnt_wx), sht_me.Cells(x, 2), sht_wx.Range("c3:c" & cnt_wx)) '维修数量
sht_me.Cells(x, 6).Value = Application.WorksheetFunction.SumIf(sht_wx.Range("b3:b" & cnt_wx), sht_me.Cells(x, 2), sht_wx.Range("d3:d" & cnt_wx)) '报废数量
Next x

Set d = Nothing

wb_bl.Close False
wb_wx.Close False

Set wb_bl = Nothing
Set wb_wx = Nothing
Application.ScreenUpdating = True
End Sub

追问

加我  详细说下   有更多好处的

追答

已加