新手上路,同样的公共盘VB程序别人可以运行,我的只能运行一部分
程序如下:Private RSMTL As New Connection
Private RSTQC As New Connection
Private RSTQC1 As New Connection
Private RSMTL1 As New Connection
Private RSMTL2 As New Connection
Private RSPUR As New Connection
Private PUR As New Recordset
Private MTL As New Recordset
Private MTL2 As New Recordset
Private TQC As New Recordset
Private TQC1 As New Recordset
Private MTL1 As New Recordset
Private i, M, T As Integer
Private A(65536) As String
Public K As Integer
Private B As Boolean
Private DATE1, DATE2, MTLNO1 As String
Sub CRCHAXUN()
On Error Resume Next
RSMTL.Open "Provider=MSDAORA.1;Password=MPS180901;User ID=MPS;Data Source=""(DESCRIPTION =(ADDRESS_LIST =(ADDRESS =(PROTOCOL = TCP)(HOST = 10.128.8.3)(PORT = 1521)))(CONNECT_DATA =(SERVICE_NAME = TJDB)))"";Persist Security Info=True"
RSMTL1.Open "Provider=MSDAORA.1;Password=MPS180901;User ID=MPS;Data Source=""(DESCRIPTION =(ADDRESS_LIST =(ADDRESS =(PROTOCOL = TCP)(HOST = 10.128.8.3)(PORT = 1521)))(CONNECT_DATA =(SERVICE_NAME = TJDB)))"";Persist Security Info=True"
RSPUR.Open "Provider=MSDAORA.1;Password=MPS180901;User ID=MPS;Data Source=""(DESCRIPTION =(ADDRESS_LIST =(ADDRESS =(PROTOCOL = TCP)(HOST = 10.128.8.3)(PORT = 1521)))(CONNECT_DATA =(SERVICE_NAME = TJDB)))"";Persist Security Info=True"
i = 5
M = 0
Do Until Cells(i, 2) = ""
MTL.Open "SELECT * FROM MTLE020M WHERE SHIP_NO='" & Cells(i, 2) & "'", RSMTL
MTL1.Open "SELECT * FROM MTLE029M WHERE APPLY_NO='" & Cells(i, 2) & "'", RSMTL1
A(M) = Trim(MTL("VEND_NO"))
PUR.Open "SELECT * FROM PURA010M WHERE VENDOR_NO ='" & A(M) & "'", RSPUR
Cells(i, 6) = Trim(PUR("VENDOR_NAMEC"))
Cells(i, 8) = Trim(MTL("IN_QTY")) / 1000
Cells(i, 9) = Trim(MTL("C_CHECK"))
Cells(i, 10) = Trim(MTL("SI_CHECK"))
Cells(i, 11) = Trim(MTL("P_CHECK"))
Cells(i, 12) = Trim(MTL("S_CHECK"))
Cells(i, 14) = Trim(MTL("CR_CHECK"))
Cells(i, 13) = Trim(MTL("Ca_CHECK"))
Cells(i, 15) = Trim(MTL("Ni_CHECK"))
Cells(i, 16) = Trim(MTL("Mn_CHECK"))
Cells(i, 17) = Trim(MTL("Mo_CHECK"))
Set rng = Worksheets("备注").Range("B1:B65536").Find(What:=Cells(i, 2).Value, LookAt:=xlWhole, LookIn:=xlValues)
Cells(i, 5) = ""
Cells(i, 5) = rng.Offset(, 1).Value
If Cells(i, 9) <> 0 Then
Cells(i, 18) = "实验分析值"
Else
Cells(i, 18) = ""
End If
If Cells(i, 18) = "" Then
Cells(i, 9) = Trim(MTL("C_IN"))
Cells(i, 10) = Trim(MTL("SI_IN"))
Cells(i, 11) = Trim(MTL("P_IN"))
Cells(i, 12) = Trim(MTL("S_IN"))
Cells(i, 14) = Trim(MTL("CR_IN"))
Cells(i, 13) = Trim(MTL("Ca_IN"))
Cells(i, 15) = Trim(MTL("Ni_IN"))
Cells(i, 16) = Trim(MTL("Mn_IN"))
Cells(i, 17) = Trim(MTL("Mo_IN"))
Cells(i, 18) = "厂商证明值"
End If
If Not MTL1.EOF Then
Cells(i, 19) = Trim(MTL1("P_P"))
End If
i = i + 1
M = M + 1
PUR.Close
MTL.Close
MTL1.Close
Loop
RSMTL.Close
RSMTL1.Close
RSPUR.Close
A(M) = ""
边框线
排序
End Sub
Sub 边框线()
Range("A5:T100").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
运行结果如下:
我的运行结果如下:
未运算的部分应该来自公司内部网,网页我有权限访问,表格放在公共盘,别人的电脑可以运算出结果,麻烦各位大佬帮忙看下什么问题