0

我有两个工作表（表 1 和表 2）。表 1 有 500X500 表。我想 - 遍历每一行（每个单元格） - 识别其中具有值“X”的单元格 - 选择相应的列标题值并将其存储在工作表 2 中的单元格中

例如

AA  BB  CC  DD  EE  FF  GG  HH
GHS                     X   
FSJ         X               
FSA X                       
MSD                         
SKD                         
SFJ X                       X
SFJ                         
SFM             X           
MSF                     X

有没有一种方法可以编写一个宏，它将以以下形式提取值

GHS -> GG
FSJ->DD
.
.
SFJ->BB HH

我尝试过循环算法，但似乎不起作用。谁能帮助我，因为我对宏很陌生。

4

2 回答 2

0

试试这个 .. 假设 GHS、FSJ ......在 A 列

Sub ColnItem()
Dim x, y, z As Integer
Dim sItem, sCol As String
Dim r As Range

z = 1
For y = 1 To 500
  sItem = Cells(y, 1)
  sCol = ""
  For x = 2 To 500
    If UCase(Cells(y, x)) = "X" Then
      If Len(sCol) > 0 Then sCol = sCol & " "
      sCol = sCol & ColumnName(x)
    End If
  Next
  If Len(sCol) > 0 Then
    Sheets("Sheet2").Cells(z, 1) = sItem & " -> " & sCol
    z = z + 1
  End If
Next
End Sub

Function ColumnName(ByVal nCol As Single) As String
Dim sC As String
Dim nC, nRest, nDivRes As Integer

sC = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
nC = Len(sC)

nRest = nCol Mod nC
nDivRes = (nCol - nRest) / nC

If nDivRes > 0 Then ColumnName = Mid(sC, nDivRes, 1)
ColumnName = ColumnName & Mid(sC, nRest, 1)
End Function
于 2013-07-23T17:26:23.833 回答
0

我已将值 GG 等放在 Sheet2 的单独列中，但可以修改代码以将所有信息（一行）放在单个单元格中。

Sub GetColumnHeadings()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range, rng As Range
    Dim off As Integer

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    Set rng1 = ws1.Range("A1").CurrentRegion
    'CurrentRegion is the Range highlighted when we press Ctrl-A from A1
    Set rng2 = ws2.Range("A1")
    Application.ScreenUpdating = False
    For Each rng In rng1
        If rng.Column = 1 Then off = 0
        If rng.Value = "X" Then
            rng2.Value = rng.EntireRow.Cells(1, 1).Value
            off = off + 1
            rng2.Offset(0, off).Value = rng.EntireColumn.Cells(1, 1).Value
        End If
        'if we are looking at the last column of the Sheet1 data, and
        'we have put something into the current row of Sheet2, move to 
        'the next row down (in Sheet2)
        If rng.Column = rng1.Column And rng2.Value <> "" Then
            Set rng2 = rng2.Offset(1, 0)
        End If
    Next rng

    Application.ScreenUpdating = True
    Set rng = Nothing
    Set rng2 = Nothing
    Set rng1 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
End Sub

我还基于原始帖子中的电子表格示例，其中 AA 似乎位于单元格 A1 中。

于 2013-07-23T19:38:50.570 回答