0

你好再次stackoverflow。我今天的问题是从另一个表上的单元格返回一个值，常数很少。我有一系列列，它们采用不可更改的输入，并使用一些公式和宏将其转换为有用的数据。最终结果类似于；

( A )                            
Cage
10
ct
Cage
5
ct
Bin
3
CT
Bin
4
CT
CT
Bin
11
CT

我想做的是在 A1:A16 中找到“Bin”，然后将其下的值直接返回到 sheet2 上的单元格。然后，我需要计算该“Bin”下存在多少“ct”，并将该值返回到与 sheet2 上的总数相邻的单元格，以获得类似的输出；

Bin1 3 1   Bin2 4 2   Bin3 11 1

信息的位置每天都会变化，但会保持在同一行。顺序始终保持不变，例如，3 对应于第一个 Bin，4 对应于第二个 Bin，11 对应于第三个，尽管每天可能或多或少。

感谢您提供的任何帮助。

4

2 回答 2

0

您可以尝试使用Do...LoopwithRange.Find方法，因为您的信息每天都会发生变化。作为一个不需要排序的示例，并且可以灵活地更改数据：

Dim bin_count As Integer 'bin count
bin_count = 1
Dim sheet2_plcmnt As Integer 'sheet 2 placeholder
sheet2_plcmnt = 1

Dim cur_row As Long 'current row
Dim nxt_row As Long 'next row
Dim loop_tst As Integer 'loop test

'---prime do...loop---
cur_row = Worksheets("Sheet1").Range("A:A").Find("Bin").Row
nxt_row = Worksheets("Sheet1").Range("A:A") _
  .FindNext(Cells(cur_row, 1)).Row
loop_tst = 0
'delete previous data in Sheet2, row 1
Worksheets("Sheet2").Rows(1).Delete
'use .activate so CountIf works properly in loop below
Worksheets("Sheet1").Activate

'---run loop through all cells in column A---
'= 0 have not reached end; = 1 reached end but need to run
'one more time; = 2 exit loop
Do While loop_tst < 2
  'put in values...
  'bin # (contiguous, starting at 1)
  Worksheets("Sheet2").Cells(1, sheet2_plcmnt).Value = _
    "Bin" & bin_count
  '# after bin
  Worksheets("Sheet2").Cells(1, sheet2_plcmnt + 1).Value = _
    Worksheets("Sheet1").Cells(cur_row + 1, 1).Value
  '# of CTs after bin
  If loop_tst < 1 Then
    'if haven't reached end, check between cur_row and nxt_row
    Worksheets("Sheet2").Cells(1, sheet2_plcmnt + 2).Value = _
      WorksheetFunction.CountIf(Range(Cells(cur_row, 1), _
      Cells(nxt_row, 1)), "CT")
  Else
    'if have reached end, check between cur_row and
    'last row in column A
    Worksheets("Sheet2").Cells(1, sheet2_plcmnt + 2).Value = _
      WorksheetFunction.CountIf(Range(Cells(cur_row, 1), _
      Range("A1").End(xlDown)), "CT")
  End If
  '...change counters as needed
  bin_count = bin_count + 1
  sheet2_plcmnt = sheet2_plcmnt + 3
  cur_row = nxt_row
  'set next row
  nxt_row = Worksheets("Sheet1").Range("A:A") _
    .FindNext(Cells(cur_row, 1)).Row
  'adjust to determine loop behavior
  If loop_tst = 1 Then loop_tst = 2
  If cur_row > nxt_row Then loop_tst = 1
Loop

如果您使用它，请注意它会从 Sheet2 第 1 行中删除以前的数据，因此以前的计数不会留下任何残留物。
该Worksheet.Activate方法使用一次以确保CountIf功能正常工作。如果有人知道避免这种情况的方法，则可以修改代码以在没有任何Selector的情况下工作Activate。

于 2013-09-04T15:21:11.963 回答
0

我假设在“Bin”下，您请求的值始终存在，并且您希望将单元格 A1、A2、A3 中的每个“Bin X Y”写入您还没有的第二张表中打开（所以这基本上会为你打开一个新的）：

Sub Bin_count()

Dim i As Byte, j As Byte, CTs As Byte
Dim ThisPage As Worksheet, TargetPage As Worksheet
Dim NewBook As Workbook

Set ThisPage = ThisWorkbook.ActiveSheet
Set NewBook = Workbooks.Add   ' or you can address an existing file with workbooks.open(filename)
Set TargetPage = NewBook.Worksheets(1) ' you can also decide the sheet where you want to write your values (here by default is the first excel's "tab")

j = 1 ' Results cells scanner

For i = 1 To 17

    If ThisPage.Cells(i, 1).Text = "Bin" Then                                     ' if "Bin is found...

        ThisPage.Activate
        Cells(i + 1, 1).Activate

        Do Until IsEmpty(ActiveCell)                                              ' ...scan all cells below...
            If ActiveCell.Text = "CT" Then CTs = CTs + 1                          '...to find all CTs and store their number in a variable...
            ActiveCell.Offset(1, 0).Activate
        Loop

        TargetPage.Cells(1, j) = "Bin " & ThisPage.Cells(i + 1, 1) & " " & CTs '... at the end and write Bin + number under it + number of CTs found
        j = j + 1  ' should you need to write in column instead of row, simply write targetpage.cells(j,1) instead of the previous statement

    End If

Next i

End Sub
于 2013-09-04T07:39:09.113 回答