Sub Macro()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Str As String
Set fs = CreateObject("scripting.filesystemobject")
Set ft = fs.createtextfile(ThisWorkbook.Path & "" & "仪器一览表" & ".txt")
Set xlBook = ThisWorkbook
For x = 1 To xlBook.Sheets.Count
Set xlSheet = xlBook.Sheets(x)
For y = 6 To xlSheet.UsedRange.Rows.Count
For Z = 1 To xlSheet.UsedRange.Columns.Count
If Z = 5 Or Z = 6 Then
Str = Str & Trim(Replace(Replace(xlSheet.Cells(4, 5) & "-" & xlSheet.Cells(5, Z), Chr(10), ""), " ", "")) & ":" & Trim(Replace(Replace(xlSheet.Cells(y, Z), Chr(10), ""), " ", "")) & Chr(10)
Else
Str = Str & Trim(Replace(Replace(xlSheet.Cells(4, Z), Chr(10), ""), " ", "")) & ":" & Trim(Replace(Replace(xlSheet.Cells(y, Z), Chr(10), ""), " ", "")) & Chr(10)
End If
Next Z
Str = Str & Chr(10)
Next y
Next x
ft.WriteLine (Str)
ft.Close
Set ft = Nothing: Set fs = Nothing