各位大大 好，
最近想写一个VBA程式码.但一直想不到怎么写.当然也有透过chatgpt编写.
但一直没得到解答.所以请各位大神协助看一下或改写VBA程式码.
先说一下我的需求:
这个VBA会直接在档案1里的VB执行.
将档案1里工作表1的C1、E1、G1、I1、K1、M1共计6个个别的储存格值与A栏(从A2开始到最后1行)分别
去对比档案2里工作表3的B2到H2以及A栏(从A3开始到最后1行).当双双匹配时.先将取得工作表3的交叉储存格的值.
然后填入工作表1的交叉储存格里.若不能双双匹配时.则不处理.
用1个例子说明会更好理解一些.例如当工作表1的C1=工作表3的B2.而且工作表1的A2等工作表3的A3.
此时取工作表3的交叉储存格B3的值.然后填入工作表1的交叉储存格C2.依序将工作表1的C/E/G/I/K/M栏的空格填上数值.
若不能双双匹配则不处理.
交叉储存就是栏的垂直向下与行的水平向右交叉的储存格.如C1与A2.它们的交叉在C2.
参照附件档案会更清楚明白.
以下是chatgpt所写的程式码.但一直没有数据输出.小弟不才也看不出什么原因.希望大神多帮忙.先谢了！！
Sub CompareAndFill() DimwbSource As Workbook DimwsSource As Worksheet Dim ws1As Worksheet DimcompareRange As Range DimintersectionRange As Range Dim i AsLong ' 打开每周包装工时表.xlsx文件并获取工作表对象 SetwbSource = GetObject(ThisWorkbook.Path & "\档案2.xlsx") SetwsSource = wbSource.Worksheets("工作表3") ' 获取工作表1对象 Set ws1 =ThisWorkbook.Worksheets("工作表1") ' 获取工作表3的单元格范围 B2:H2 SetcompareRange = wsSource.Range("B2:H2") ' 遍历工作表1的指定单元格 For Eachcell In ws1.Range("C1,E1,G1,I1,K1,M1") ' 获取工作表1的指定单元格的列号和行号 DimcolNum As Long DimrowNum As Long colNum = cell.Column rowNum = cell.Row ' 获取工作表3的交叉单元格的位置 SetintersectionRange = wsSource.Cells(rowNum + 1, colNum - 1) ' 对比工作表1的指定单元格与工作表3的对应单元格 Ifcell.Value = compareRange(1, colNum - 1).Value Then '对比工作表1的A列与工作表3的A列 Ifws1.Cells(rowNum + 1, 1).Value = wsSource.Cells(rowNum + 2, 1).Value Then ' 将工作表3的交叉单元格的值填充到工作表1的交叉单元格中 ws1.Cells(rowNum + 1, colNum).Value = intersectionRange.Value End If EndIf Next cell ' 关闭每周包装工时表.xlsx文件并清除对象引用 wbSource.CloseSaveChanges:=False SetwsSource = Nothing SetwbSource = Nothing ' 清除对象引用 SetcompareRange = Nothing SetintersectionRange = Nothing Set ws1 =Nothing End Sub
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-6-30 18:44
楼主