作者：绿色风
分类：
时间：2022-08-18
浏览：160
楼主
水星钓鱼 |
下图列举了两个工作表，分别为“项目数据库”和“修改规则”。现在希望通过VBA把“项目数据库”中的“标准名称”与修改规则中的“项目名称”一致的对应的“收费”和“主检”按照修改规则进行修改。举例说明如下：
比如C3单元格的“标准名称”为“材质”与“修改规则”中的“项目名称”材质匹配，所以需要将“标准名称”为“材质”对应的收费和主检修改为“修改规则”中的“新收费”和“新主检”
附件如下：
 VBA练习02 按规则修改对应的内容.rar
要求：
1.不得使用循环语句
2.第一个回答正确的，加技能分1分，魅力值3分，优秀答案（指想法新颖）加技能分3分，魅力值5分。其余回答正确者加魅力值1分。3.提示下用SQL语句完成
|
2楼
oldyuan |
- Sub oldyuan()
- Dim LastRow&, LastRow1&
- LastRow = Sheets("项目数据库").UsedRange.Rows.Count
- LastRow1 = Sheets("修改规则").UsedRange.Rows.Count - 1
- Application.ScreenUpdating = False
- With Range("E1")
- .FormulaArray = "=IF(ISNA(VLOOKUP(C1,修改规则!$A$1:$B$" & LastRow1 & ",2,)),D1,VLOOKUP(C1,修改规则!$A$1:$B$" & LastRow1 & ",2,))"
- .AutoFill Range("E1:E" & LastRow)
- End With
- With Range("F1")
- .FormulaArray = "=IF(ISNA(VLOOKUP(C1,修改规则!$A$1:$C$" & LastRow1 & ",3,)),A1,VLOOKUP(C1,修改规则!$A$1:$C$" & LastRow1 & ",3,))"
- .AutoFill Range("F1:F" & LastRow)
- End With
- Range("D1:D" & LastRow) = Range("E1:E" & LastRow).Value
- Range("A1:A" & LastRow) = Range("F1:F" & LastRow).Value
- Columns("E:F").Delete
- Application.ScreenUpdating = True
- End Sub
|
3楼
amulee |
玩玩
- Sub SQL()
- Dim SQL As String
- Dim Conn As Object
- Dim Rst As Object
- Set Conn = CreateObject("ADODB.Connection")
- Conn.Open "Provider=Microsoft.ace.Oledb.12.0;" & _
- "Extended Properties=Excel 12.0 Xml;" & _
- "Data Source=" & ThisWorkbook.FullName
- SQL = "Select IIF(B.项目名称 Is Null,A.主检,B.新主检) As 主检,A.项目名称,A.标准名称,IIF(B.项目名称 Is Null,A.收费,B.新收费) As 收费 From [项目数据库$] A Left Join [修改规则$] B On A.标准名称=B.项目名称"
- Set Rst = Conn.Execute(SQL)
- Sheet1.Range("A2").CopyFromRecordset Rst
- Rst.Close
- Conn.Close
- Set Conn = Nothing
- Set Rst = Nothing
- End Sub
|
4楼
LOGO |
没仔细看题.再想想先。。
- Sub 变更()
- Dim 旧, 新, i As Integer, y As Integer
- 旧 = Worksheets("项目数据库").Range("a1").CurrentRegion
- 新 = Worksheets("修改规则").Range("a1").CurrentRegion
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- For i = 2 To UBound(旧)
- For y = 2 To UBound(新)
- If 旧(i, 2) = 新(y, 1) Then
- 旧(i, 1) = 新(y, 3)
- 旧(i, 4) = 新(y, 2)
- End If
- Next
- Next
- Worksheets("项目数据库").Range("a1").Resize(UBound(旧), UBound(旧, 2)) = 旧
- Application.ScreenUpdating = True
- Application.Calculation = xlCalculationAutomatic
- End Sub
|
5楼
xgixvuxx |
我在这里找了不少剑灵的服装替换 网站叫希望之地 还不错 他们搞剑灵破解挺专业的 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一