前幾天朋友突然問我會不會VBA，詢問我可不可以教她寫出想要的程式，我姑且聽了一下，發現這題目很有趣，也剛好能應用到上課所講的演算法，因此就決定幫她忙，寫完之後又更愛上VBA了~~

題目

關於題目的描述是這樣的，朋友給我一張Excel表格，橫軸代表經過的機台，縱軸代表各個產品，有數字1的代表那項產品有通過這機台。

目的是要經由演算法找出最少樣的產品數跑過最多的機台，也就是像下面這樣，只要找出其中的三樣產品，全部的機台就都跑過了，貌似她是要抓其中的資料拿去測試，如果全部都測的話太花時間，只拿三筆資料去測就可以拿到所有的機台資料似乎效率就提升許多

交大開放式課程 貪婪演算法
我首先是想到用上課交的方法去解，先挑第一個產品，然後根據貪婪演算法，把有重疊的都拿掉並選擇通過機台數最多的，一直按照此循環就可以找到最佳解了，示意圖大概像下面這樣

假設我選產品2，那麼可以把和它重疊的產品1和產品5刪除，剩下產品3和4可以選，根據貪婪演算法的概念要選最大的，因此選到產品4，最後才選擇產品3，因此其中一組算出來就是三個產品跑過5個機台，我寫了個VBA算出選擇每個產品根據貪婪演算法分類後的族群如下圖所示

橫軸代表我第一次選擇的產品，縱軸代表對應的產品，像剛剛解釋的結果就顯示在C這一行中，代表如果我第一次選擇產品2之後根據貪婪演算法會選擇到2、3、4這個族群，總數會是通過六台機器，很顯然的這個不是我們想要的答案，最理想的答案是選第一個產品，全部機台都跑過，達成最少產品數跑過最多機台的目標

下面是程式碼:

	Public Function main()
	For all_row = 2 To 6
	been_chose_group = group_pick(all_row)
	For n_row = 2 To 6
	Cells(6 + n_row + 2, all_row) = been_chose_group(n_row, 0)
	Next n_row
	Cells(6 * 2 + 4, all_row) = been_chose_group(all_row, 1)
	Next all_row
	End Function
	Function pick_row_from_can_be_chose_group(can_be_chose_group)
	pick_row_from_can_be_chose_group = -1
	For n_row = 2 To 6
	If can_be_chose_group(n_row, 0) = 1 Then
	pick_row_from_can_be_chose_group = n_row
	Exit For
	End If
	Next n_row
	End Function
	Function group_pick(input_row)
	Dim can_chose_row_matrix(6, 1) As Integer
	Dim been_chose_group(6, 2) As Integer
	For n_row = 2 To 6
	been_chose_group(n_row, 0) = 0
	Next n_row
	For n_row = 2 To 6
	can_chose_row_matrix(n_row, 0) = n_row
	Next n_row
	input_matrix = row_to_matrix(input_row)
	pick_return = 0
	col = 1
	Do Until pick_return = -1
	pick_return = pick(input_matrix, can_chose_row_matrix)
	If pick_return = -1 Then
	Exit Do
	Else
	can_chose_row_matrix(pick_return, 0) = 0
	End If
	been_chose_group(pick_return, 0) = pick_return
	input_matrix = return_matrix_of_add_row_and_matrix(input_matrix, pick_return)
	col = col + 1
	Loop
	been_chose_group(input_row, 0) = input_row
	max_sum = 0
	For col = 2 To 7
	max_sum = max_sum + input_matrix(0, col)
	Next col
	been_chose_group(input_row, 1) = max_sum
	group_pick = been_chose_group
	End Function
	Function pick(input_matrix, can_chose_row_matrix)
	max_n = 0
	For n_row = 2 To 6
	If can_chose_row_matrix(n_row, 0) <> 0 Then
	return_if = if_fit(input_matrix, n_row)
	fit = return_if(0, 0)
	two_sum = return_if(0, 1)
	If fit = True Then
	If two_sum > max_n Then
	max_n = two_sum
	pick = n_row
	End If
	End If
	End If
	Next n_row
	If max_n = 0 Then
	pick = -1
	End If
	End Function
	Function if_fit(matrix_a, row_b)
	Dim save_matrix_row_data(1, 7) As Integer
	Dim add_return(1, 2) As String
	Dim n_sum As Integer
	add_return(0, 0) = True
	For i = 2 To 7
	save_matrix_row_data(0, i) = matrix_a(0, i) + Cells(row_b, i)
	If save_matrix_row_data(0, i) = 2 Then
	add_return(0, 0) = False
	End If
	Next i
	n_sum = 0
	For i = 2 To 7
	n_sum = n_sum + save_matrix_row_data(0, i)
	Next i
	add_return(0, 1) = n_sum
	if_fit = add_return
	End Function
	Function row_to_matrix(input_row)
	Dim save_matrix_row_data(1, 7) As Integer
	For i = 2 To 7
	save_matrix_row_data(0, i) = Cells(input_row, i)
	Next i
	row_to_matrix = save_matrix_row_data
	End Function
	Function return_matrix_of_add_row_and_matrix(input_matrix, input_row)
	Dim save_matrix_row_data(1, 7) As Integer
	For i = 2 To 7
	save_matrix_row_data(0, i) = input_matrix(0, i) + Cells(input_row, i)
	Next i
	return_matrix_of_add_row_and_matrix = save_matrix_row_data
	End Function

view raw Excel VBA_group_pick_done.txt hosted with by GitHub

但套用在剛剛講的例子後，我發現剛剛講的方法只適合用在沒有重複的情形，如果有重複的話，那麼每個群裡面就只有當初選的那樣產品，就像下面這樣

因此得另外想辦法解決，最後想出的辦法是這樣的，先用countif 算出每個機台總共通過的產品數，然後找出最少的那一個機台，像下面這樣，因此我們會選到總數為13的那個機台

然後我們用加總算出每一個產品總共通過的機台數目，放在最右邊那一行如下

我們將總數為13的那個機台所有產品皆篩選出來如下，右邊分別為各個產品跑過的總機台數目，我的想法選擇跑過最多機台的那個產品應該可以使我的效率最大化

因此第一個選擇的產品已經出來了，就是綠色的那一個產品，他跑過20台機器且包含跑過最少台產品的機器，因此選這個產品一定可以讓我們的效率最大化

因此我們根據剛剛的想法將和這個產品重疊的都隱藏起來，可以得到下圖。

重複剛剛的步驟開始挑第二個產品，可以看到最少的是加總為14的那一台機器，一樣挑所有產品裡面跑過最多機台的那個產品，所以我們可以得到如下正解，僅僅挑選三片產品就可以使我跑過的機台數最大化

下面是VBA完整程式碼:

	Sub fast()
	original_col = 26
	original_row = 106
	Do Until original_col = 1
	cut_number = copy_cut(original_row, original_col)
	original_col = original_col - cut_number
	If original_col = 1 Then
	Exit Do
	End If
	Loop
	ActiveSheet.Copy after:=ActiveSheet
	For r = 2 To 106
	If Cells(r, 1).Interior.ColorIndex <> 3 Then
	Cells(r, 1).EntireRow.Hidden = True
	End If
	Next r
	End Sub
	Function copy_cut(data_row, data_col)
	ActiveSheet.Copy after:=ActiveSheet
	wafer_min = 100
	For col = 2 To data_col
	find_min = Cells(data_row + 1, col)
	If find_min < wafer_min Then
	wafer_min = find_min
	min_col = col
	End If
	Next col
	Cells(data_row + 2, 1) = min_col
	machine_max = 0
	For r = 2 To data_row
	if_index_one = Cells(r, min_col)
	If if_index_one = 1 Then
	find_max = Cells(r, data_col + 1)
	If find_max > machine_max Then
	machine_max = find_max
	max_row = r
	End If
	End If
	Next r
	Cells(data_row + 2, 2) = max_row
	Cells(max_row, 1).Select
	Selection.Interior.Color = RGB(255, 0, 0)
	'ActiveSheet.Copy after:=ActiveSheet
	sum_hidden_col = 0
	For col = 2 To data_col
	If Cells(max_row, col) = 1 Then
	Cells(max_row, col).EntireColumn.Hidden = True
	sum_hidden_col = sum_hidden_col + 1
	End If
	Next col
	del_hidden
	copy_cut = sum_hidden_col
	End Function
	Sub del_hidden()
	On Error Resume Next
	For Each cell In ActiveSheet.UsedRange
	If cell.EntireRow.Hidden Then
	cell.Delete 3
	End If
	If cell.EntireColumn.Hidden Then
	cell.Delete 4
	End If
	Next
	On Error GoTo 0
	End Sub

view raw greedy_two hosted with by GitHub

下面是示範影片:

經過這個練習，我終於了解以前上課演算法所教的東西，有時並不是依樣畫葫蘆就可以達到想要的結果，像這一題就必須自己加以變化才能找到最佳解答。像這樣能夠把繁雜的工作藉由程式來完成是我最喜歡做的事了，別人可能拉拉點點好幾分鐘，寫完程式只要點一下就全部完成，雖然寫的過程艱辛，找函式找很久，除錯也除好久，但是寫完得到滿滿的成就感阿~~分享給還不會VBA的同學們，希望看完這篇文章的你可以快點加入學習VBA的行列 ^.^

參考資料:

http://tieba.baidu.com/p/1274374476
http://forum.twbts.com/viewthread.php?tid=12378
https://blog.gtwang.org/programming/vba/