select case形式的过滤器，数据用外部文件输入，内部编程用一个变量参数？？

xin-ge

1:主程序  调试成功的

Sub getvalves()
Dim cName As String
Dim nHandle As String
Dim nScale As Double
Dim nRotation As Double
Dim sLayer As String
Dim yline As Integer
Dim ent As Object
Dim obname As String
Dim xy As Variant
Dim varattr As Variant
Dim attrtxt As Variant
Dim varAttributes As Variant
On Error Resume Next
Dim Excel As Object
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
'创建Excel应用程序实例
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
Set ExcelSheet = Excel.ActiveSheet
Excel.Visible = True
      
   '''''''''''''
      If ExcelSheet.cells(1, 1).Value = "" Then
         ExcelSheet.cells(1, 1).Value = "块名称"
         ExcelSheet.cells(1, 2).Value = "阀名称"
         ExcelSheet.cells(1, 3).Value = "尺寸"
         ExcelSheet.cells(1, 4).Value = "等级"
         ExcelSheet.cells(1, 5).Value = "数量"
         ExcelSheet.cells(1, 6).Value = "（配套法兰数量）"
         ExcelSheet.Range("A1:F1").Characters.Font.FontStyle = "加粗"
         yline = 2 '写入行位置
'  ExcelSheet.Cells(1, 7).Value = yline
      Else
   yline = ExcelSheet.UsedRange.Rows.Count + 1
  '   ExcelSheet.Cells(2, 8).Value = yline
    End If
   
   '''''''''''''''''''
For Each ent In ThisDrawing.ModelSpace '在模型空间里循环
obname = ent.ObjectName '提取对象类型
If obname = "AcDbBlockReference" Then '判断对象是否为块
cName = ent.Name '获取块名
varAttributes = ent.GetAttributes
xy = ent.InsertionPoint '获取插入点坐标
nHandle = ent.Handle '获取块句柄
nScale = ent.XScaleFactor '获取比例
nRotation = ent.Rotation '获取角度
sLayer = ent.Layer
varattr = ent.GetAttributes ' 将块属性标记和值复制到varattr变量
attrtxt(0) = varattr(0).TextString '属性值 0
attrtxt(1) = varattr(1).TextString '属性值 1
attrtxt(2) = varattr(2).TextString '属性值 2


On Error Resume Next
'''''''''''''''''''''''''''''''''
'ExcelSheet.Range("a:a").Visible = False '自动隐藏A列

    Select Case cName
      Case "ABAV1-C"
      ExcelSheet.cells(yline, 1).Value = cName
           ExcelSheet.cells(yline, 2).Value = "Ball valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
            ExcelSheet.cells(yline, 6).Value = 0
        
    Case "flg-c"
      ExcelSheet.cells(yline, 1).Value = cName
           ExcelSheet.cells(yline, 2).Value = "flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 2
           ExcelSheet.cells(yline, 6).Value = 0
           
      Case "abav1-c"
      ExcelSheet.cells(yline, 1).Value = cName
           ExcelSheet.cells(yline, 2).Value = "Ball valve"
           ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "abav2-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "Closed ball valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "abav3-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "ball valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "abav4-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "Closed ball valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "achv1-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "check valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0


      Case "achv2-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "check valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "ACHV-C"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "check valve with 1 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 1
      Case "acov3-c"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "presure regulator"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
    Case "agav1-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "gate valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "agav2-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "closed gate valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "aglv2-c"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "closed globle valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "aglv4-c"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "closed globle valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
          ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "aglv8-c"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "closed globle valve with 1 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 1

      Case "apsv1-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "pressure relief valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "APSV2-C"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "pressure relief valve with 2 flange"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 2
      Case "asdv2-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "hydraulic/pneumatic operated valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "bnev-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "needle valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
           
'ExcelSheet.Cells(yline, 4).Value = varAttributes(0).TextString
      Case "bstw-c"
     ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "three way solenoid valve"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0
      Case "dplug-c"
      ExcelSheet.cells(yline, 1).Value = cName
          ExcelSheet.cells(yline, 2).Value = "pluge"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
          ExcelSheet.cells(yline, 5).Value = 1
          ExcelSheet.cells(yline, 6).Value = 0
      Case "conr-c"
      ExcelSheet.cells(yline, 1).Value = cName
      ExcelSheet.cells(yline, 2).Value = "reducer"
          ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
          ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
           ExcelSheet.cells(yline, 5).Value = 1
           ExcelSheet.cells(yline, 6).Value = 0

       Case Else
yline = yline - 1
   End Select

'''''''''''''''''''''''''''''''''''''''''''
yline = yline + 1 '位置加一行

On Error Resume Next
End If
On Error Resume Next
Next
ExcelSheet.Range("b:b").entirecolumn.AutoFit '自动调整当前工作表A列的列宽
ExcelSheet.Range("F:F").entirecolumn.AutoFit '自动调整当前工作表A列的列宽
'ExcelSheet.cells(2, 2).FreezePanes = True '自动冻结A列
ExcelSheet.Rows(2).Select
Excel.ActiveWindow.FreezePanes = True
ExcelSheet.cells(2, 10).Select
'ExcelSheet.Columns("a:a").Entirecolumn.Hidden = True '自动隐藏A列
Excel.Visible = True
On Error Resume Next
Set Excel = Nothing '释放变量
On Error Resume Next
Set ExcelSheet = Nothing
On Error Resume Next
End Sub

2：excel文件读入cad  测试成功的


Public Sub exceltocad1()  '读取索引文件，块名和管件名称ByRef bname
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strFileName As String
Dim ObjectCount As Long  '存储索引文件的数量，行数
Dim bname()
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Excel软件没有正确打开。", vbOKOnly + 16, "提示："
    Exit Sub
End If
strFileName = InputBox("输入管件索引数据路径\ *.xls）.", "打开文件：")
If Dir(strFileName) = "" Then
    MsgBox "文件未找到。"
    Exit Sub
End If
Set xlBook = xlApp.Workbooks.Open(strFileName)
Set xlSheet = xlBook.Worksheets(1)
ObjectCount = xlSheet.UsedRange.Rows.Count '获取A列最后一个单元格的行数

'Dim blockname(), fittingsname() '开头定义了
ReDim bname(ObjectCount - 1, 2)
bname = xlSheet.[A2:B & ObjectCount] '区域赋值给二位数组
'exceltocad = bname
   MsgBox bname(1, 2)
xlBook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
'MsgBox "加载成功"
End Sub

3： 想把程序1中 select case语句 用一个循环搞定，
  case的每一个值用excel文本读入，如下形式

Dim i
For i = 0 To ObjectCount - 2
    Select Case cName
      Case blockname(i)
      ExcelSheet.Cells(yline, 1).Value = cName
      ExcelSheet.Cells(yline, 2).Value = fittingsname(i)
      ExcelSheet.Cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
      ExcelSheet.Cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
      ExcelSheet.Cells(yline, 5).Value = quantity(i)
      Case Else
yline = yline - 1
   End Select



4：求解，我一直没调试成功？？？？？？？？？？？？？？？？？？
此程序目的是——以外部excel文档给的 blockname（块名称），为case过滤器条件，讲当中这个块全部选择出来，并输入一个新的excel文档中，
新的文档中包含：blockname、fittingsname、等五项

geabus

表述不清？关键代码不全？
逐句调试吧