Question

再次问好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上的total相邻的单元格，以获得类似的输出;

Bin1 3 1   Bin2 4 2   Bin3 11 1

信息的位置每天都会改变，但它会保持在同一行。订单将始终保持不变，例如，3将与第一个Bin对应，4与第二个Bin对应，11与第三个对应，但每天可能会有更多或更少。

感谢您提供任何帮助。

Answer 1

我假设在“Bin”下，您请求的值始终存在，并且您想要在单元格A1，A2，A3，......中的每个“Bin XY”中写入第二张表已经打开了（所以这基本上会为你打开一个新的）：

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

Answer 2

您可以尝试使用Do...Loop Range.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函数正常工作。如果有人知道避免这种情况的方法，则可以修改代码，使其无需Select或Activate。

如何从每天更改位置的另一个工作簿返回值

2 个答案: