Function ConnectRst(Sql As String) As ADODB.Recordset
    Dim Cnn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & ThisWorkbook.FullName
    Rst.Open Sql, Cnn, adOpenStatic
    Set ConnectRst = Rst
End Function
好像由于adOpenStatic的原因,记录不能修改.
做了如下修改,也不行.
 Rst.Open Sql, Cnn, adOpenDynamic, adLockBatchOptimisticSub ConnectPipeTableAndHG20617()
  Dim Rst As ADODB.Recordset, Rst1 As ADODB.Recordset
  Dim Sql As String
  'Sql = "select WK,StandardNo,'法兰WN'& SIZE From [PipeTable$]"
  Sql = "select trim(WK),StandardNo,'法兰WN'& DN & '-2.0 RF','316L', Dn,trim(SERVICE) From [按公称直径计算$] "
    Sql = Sql & " Where StandardNo = 'HG20617'"
    
    
  Set Rst = ConnectRst(Sql)
  Dim Dn As Double, Pn As Double
  With Rst
    .MoveFirst
    For ii = 0 To .RecordCount - 1
      DDN = .Fields(4) '("Dn")
      Pn = 2#
      Sql = "Select 理论重量 from [Sheet1$] Where PN = '2.0'  and DN = " & DDN
      Set Rst1 = WithSqlReturnExcelRecordSet(Sql, ThisWorkbook.Path & "\HG20617")
      llss = .Fields(4) '测试了为double
      llss1 = Val(Rst1.Fields(0)) '转为Double
      .Fields(4) = 11 'llss1 'Val(Rst1.Fields(0)) '此句不执行.      '.Update (.Fields(4))
      .MoveNext
    Next ii
    
  End With
  With Sheets("PipeTable")
     .Range("A:Z").ClearContents
     .Range("A2").CopyFromRecordset Rst
  End With
End Sub