[已解决]谢谢爱疯老师,这个VB怎么调整

lhj323323 · 发表于 2009-12-7 12:51

爱疯老师,您前几日写的VB测试成功了,目前,我根据您的VB进行一些小的调整,却发现不能成功导入,请帮忙看看需要调整哪里,谢谢

U4YbTDBz.rar (15.68 KB, 下载次数: 1)

和气生财 · 发表于 2009-12-7 13:21

哈哈，专人负责，，，，

爱疯 · 发表于 2009-12-7 13:30

aVFXwHa2.rar (15.08 KB, 下载次数: 2)

lhj323323 · 发表于 2009-12-7 13:36

您客气了，能者为师嘛

刚才您上传的附件报错，还有呢，我再说明一下

那天我提的需求是从A到B的导入，今天提出的是从B到C的导入，是不同的VB需求，也就是就那天的数据源表已不存在，而那天的结果表在今天的需求中是数据源的功能，C表才是今天的结果表。

我这次上传的附件中，已在VB里将工作表的指向进行了调整，不过还是报错，故才于今天上传求助。

数据源结果表

------------------------------------------------

上次数据源结果表

------------------------------------------------

这次结果表 B表

[此贴子已经被作者于2009-12-7 13:41:15编辑过]

爱疯 · 发表于 2009-12-7 13:51

QUOTE:

以下是引用lhj323323在2009-12-7 13:36:00的发言：

您客气了，能者为师嘛

刚才您上传的附件报错，还有呢，我再说明一下

那天我提的需求是从A到B的导入，今天提出的是从B到C的导入，是不同的VB需求，也就是就那天的数据源表已不存在，而那天的结果表在今天的需求中是数据源的功能，C表才是今天的结果表。

我这次上传的附件中，已在VB里将工作表的指向进行了调整，不过还是报错，故才于今天上传求助。

数据源结果表

------------------------------------------------

上次数据源结果表

------------------------------------------------

这次结果表 B表

dZzkeF9a.rar (16.56 KB, 下载次数: 3)

lhj323323 · 发表于 2009-12-7 13:57

HhhEYNE7.rar (15.94 KB, 下载次数: 1)

爱疯 · 发表于 2009-12-7 13:58

我需要了解的是，你的问题（如果存在多个的话，现在就看成1个），已知条件是什么？最终结果是什么？

lhj323323 · 发表于 2009-12-7 14:02

QUOTE:

以下是引用爱疯在2009-12-7 13:58:00的发言：
我需要了解的是，你的问题（如果存在多个的话，现在就看成1个），已知条件是什么？最终结果是什么？

其实今天的需求已和昨天的需求不一样的，请将今天的需求看成是一个新的

已知条件是今天上传的[结果表]是数据源的地位，今天上传的B表是新增的，属于结果表的性质

今天上传的[结果表]和表的格式固定不变，需要从[结果表]中导出数据到表中，

的第一行的各列是根据用户从[结果表]第一行的各列中提取的，列数肯定比[结果表]的列数少。我需要的是你写的查找第一行标题的功能

谢谢，。

[此贴子已经被作者于2009-12-7 14:06:02编辑过]

爱疯 · 发表于 2009-12-7 14:23

ppqbyy2C.rar (17.37 KB, 下载次数: 2)

和气生财 · 发表于 2009-12-7 14:38

给你个基本的，不考虑速度。

Public Sub other_way()
Dim i_col As Integer, j_col As Integer, last_row As Long, last_col_jg As Integer, last_col_B As Integer, i_copy As Long

last_row = Worksheets("结果表").Range("a65536").End(xlUp).Row
last_col_jg = Worksheets("结果表").Range("a1").End(xlToRight).Column
last_col_B = Worksheets("B").Range("a1").End(xlToRight).Column

'copy name to sheets("B")
Worksheets("结果表").Range("a2:a" & Range("a65536").End(xlUp).Row).Copy Worksheets("B").Range("a2")

'copy related column to B
For i_col = 1 To last_col_B 'UBound(arr_B)
    For j_col = 1 To last_col_jg 'UBound(arr_jg)
        If Worksheets("结果表").Cells(1, j_col) = Worksheets("B").Cells(1, i_col) Then
            For i_copy = 2 To last_row
                Worksheets("结果表").Cells(i_copy, j_col).Copy Worksheets("B").Cells(i_copy, i_col)
            Next i_copy

        End If
    Next j_col
Next i_col

End Sub

		自动登录	找回密码
密码			注册

[已解决]谢谢爱疯老师,这个VB怎么调整

回复：（爱疯）[upload=rar]viewFile.asp?ID=98770[/u...

回复：（爱疯）以下是引用lhj323323在2009-12-7 13:36...

回复：（爱疯）我需要了解的是，你的问题（如果存在多...