查找具有相同标题的列以及仅合并和居中标题

时间:2015-07-09 12:07:04

标签: vba excel-vba excel

我有一个数据集,其中我有几个部门在不同月份的数据。我希望将相同的部门放在一起,并在所有月份合并部门名称。 数据集: http://bit.ly/1JRfyiz 输出: http://bit.ly/1Cr9Q4c 可能没有。部门和任何没有。几个月(我的意思是最多12个月)。 我无法弄清楚如何仅合并具有相同名称的标头。 请告诉我应该做什么才能获得我想要的输出。

1 个答案:

答案 0 :(得分:1)

"我无法弄清楚如何仅合并具有相同名称的标题。"

好的,那么我假设你已经找到了如何做第一部分("将相同的部门放在一起")并且您的输入已正确排序列。

然后合并的想法是从A1开始,看看那里有哪个部门,检查这个部门走多远,合并并从另一个部门的下一个单元开始。

Sub trymerge()

'Variables to know where you are
Dim start As Integer
Dim endc As Integer
start = 1
endc = 1

Application.DisplayAlerts = False
'Loop through all columns where top cell is nonempty
Do While Worksheets(1).Cells(1, start).Value <> ""
  'Loop to find columns next to each other with the same dept name
  Do While Worksheets(1).Cells(1, start).Value = Worksheets(1).Cells(1, endc).Value
    endc = endc + 1
  Loop
  endc = endc - 1

  'Merge what you found

  Worksheets(1).Range(Cells(1, start), Cells(1, endc)).Merge
  Worksheets(1).Cells(1, start).HorizontalAlignment = xlCenter
  'Move to next dept
  start = endc + 1
  endc = start
Loop

Application.DisplayAlerts = True

End Sub